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Abstract 


Computer programming, system development and analysis 
efforts during this contract were carried out in support of the 
Halogen Occultation Experiment (HALOE) at NASA/ Langley . Support 
in the major areas of data acquisition and monitoring, data 
reduction and system development are described along with a brief 
explanation of the HALOE project. Documented listings of major 
software are located in the appendix. 
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SECTION 1 - INTRODUCTION 


Support of the Halogen Occultation Experiment (HALOE) during 
this level-of— effort contract consisted of computer programming, 
system design, data acquisition, data reduction and data analysis 
efforts . 

HALOE is briefly described in Section 2 of this final 
report. Section 3 covers computer programming developments. 
Section 4 describes data acquisition support. System design is 
reviewed in Section 5, and Section 6 covers data reduction and 
data analysis support. Listings of programs are in the appendix. 
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SECTION 2 - HALOE 


The objective of the Halogen Occultation Experiment is to 
measure trace constituents of the upper atmosphere to determine 
the mechanism of ozone depletion. The HALOE instrument was 
designed to measure these gases using a solar occultation 
technique. Utilizing four gas correlation and four bolometer 
channels, the HALOE instrument will view the sun during orbital 
sunrise and sunset events to measure the spectral occultation 
caused by ozone, water vapor, nitrogen dioxide, carbon dioxide, 
hydrogen fluoride, hydrogen chloride, methane and nitric oxide. 
Knowledge of the distribution of these gases on a global level 
over a long period of time should provide the means to better 
understand the mechanism of ozone depletion. HALOE will be one 
of Ten instruments on UARS (Upper Atmosphere Research Satellite) 
currently scheduled for launch aboard the space shuttle from KSC 
in 1991. 


2-1 


SECTION 3 


SOFTWARE DEVELOPMENT 


A number of computer programs were developed under this 
contract to support the testing and characterization of the HALOE 
instrument. A variety of computer systems and languages were 
used to accomplish these tasks. Computer hardware included HP- 
1000, IBM- XT and CDC Cyber computers. Computer languages 
utilized were FORTRAN, PASCAL, FORTH and IBM assembler. 

The HALOE black body life test was supported with the 
development of a program called "HPLOT" on the CDC NOS 
facility. "HPLOT" (written in FORTRAN 5) plots the various black 
body parameters against the PRT (platinum resistance thermometer) 
and tabulates daily averages of all the parameters (see appendix 
for program listing and sample output) . 

"HARP" was developed on the HP1000 in FORTRAN to aid in the 
analysis of HALOE test data tapes. HARP will process data 
directly from tape or from disc files previously derived from 
test tapes. Data windowing features allow the user to select 
time segments for processing and/or archival to disc. Annotate 
records can be searched in a forward or reverse direction to 
locate significant events for processing. Plot files containing 
selected parameters can be created for another program "UPLOT" to 
plot on the HP pen plotter, or on the CRT. A statistics option 
allows the user to select parameters for statistical analysis and 
tabulation . 

Using Turbo Pascal on an IBM-XT fitted with a Lab Master 
card, software was developed to acquire data from the HALOE GCETS 
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(Gas Correlation Electronic Test Set) . 

Several versions of this software were created to acquire 
data for IFOV, balance-linearity, spectral response and NO noise 
tests. Data acquired by these programs was written to disc 
files. Plotter programs were developed to generate plots of the 
data on an HP pen plotter connected to an IEEE-488 card in the 
IBM-XT. LaRCNET was used to transfer some of these data files to 
NOS for analysis by the HALOE science team. 

During this contract, work was begun on software which will 
monitor the HALOE data stream on a real time basis. Data will be 
transferred from the HP1000 to the IBM-XT over an IEEE-488 bus 
(HPIB) and displayed on a color monitor in color coded form. Red 
or yellow will indicate out-of- limit conditions, while green or 
white will indicate acceptable values. The computer language 
"FORTH" was used to develop the communications between the HP1000 
and the IBM, and Turbo Pascal was used to write the display 
software for the IBM. Listings and sample output from some of 
the significant pieces of software are contained in the appendix 
to this report. 
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SECTION 4 - DATA ACQUISITION 


Data acquisition support activities were performed under 
this contract for the following specialized tests of the HALOE 
instrument: IFOV, balance-linearity, spectral response and NO 

noise testing. 

For the IFOV tests, measurements were made in azimuth and 
elevation for the gas correlation channels: HC1, HF, CH 4 , NO 

(both gas and vacuum) and for the bolometer channels: t^O, 002 # 

N 02 # O 3 . Results were tabulated and plotted immediately 
following each elevation or azimuth test (see sample plot). 

Balance-linearity test data were acquired in a similar 
manner. To determine the linearity of each channel, correlation 
coefficients were calculated and printed out immediately 
following each test. Test data were also sent to the CDC NOS 
facility for further evaluation. Data was acquired for these 
tests using software developed under this contract (described 
elsewhere in this document) on an IBM-XT fitted with a Tecmar Lab 
Master data acquisition card. 

NO noise testing was accomplished by monitoring the NO 
channels (vac. & gas) during a series of manipulations of the 
instrument and associated equipment in the clean room. 

Data acquisition efforts for the spectral response tests 
involved the use of additional software and hardware. In 
addition to the Lab Master software and hardware for data 
acquisition from the GCETS, the IBM-XT needed to communicate with 
the CD2A compudrive. This RS232 communications allowed the IBM- 
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XT to detect when the spectrometer changed wavelength. Each step 
in wavelength was then used to trigger the acquisition of data 
from the GCETS. Data, including the wavelength, was then saved 
to disc for immediate processing after each spectral test. Plots 
were generated with the IBM and an HP pen plotter. The data was 
also sent to ACD using LaRCnet for further study by the science 
team (see sample spectral response plot and the data acquisition 
block diagram which follow) . 
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SECTION 5 - SYSTEM DESIGN 


Considerable effort was made during this contract to design 
and implement a system for quick-look data reduction during the 
remaining testing at Langley and during satellite integration and 
testing when HALOE is installed on UARS (Upper Atmosphere 
Research Satellite) . The attached block diagrams show the 
hardware configuration which was proposed and which will be 
assembled, tested and utilized under a subsequent contract. Some 
of the software requirements for this system were partially 
completed during this contract and will be finished early in the 
new contract period. Other system development work was done in 
the evaluation of an automated test control system. Although 
insufficient time and resources were available to fully design 
and implement such a system, a useful subset was designed and 
implemented on the HP1000 IETS. This system involved the use of 
FORTH (a computer language) . FORTH facilitated the construction 
of commands and combinations of commands which could be issued to 
the HALOE instrument during tests. (These efforts were done 
under a separate STX contract and were accomplished by Milton 
Fabert) . 
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HALOE QUICK-LOOK DATA SYSTEM 
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SECTION 6 


DATA REDUCTION & ANALYSIS 


Data reduction and analysis efforts under this contract were 
largely concerned with the HALOE blackbody life tests. The HPLOT 
program described elsewhere in this report (and documented in the 
appendix) was utilized to evaluate, primarily through plot 
generation, a considerable quantity of HALOE blackbody test data. 

HALOE instrument test data tapes were processed using the 
CDC NOS facility. Utilizing software developed by STX personnel 
under other contracts, a large number of tapes were converted 
into data files which were then used to generate a wide variety 
of plots. These plots were instrumental in the timely evaluation 
of HALOE EMI and thermal vacuum test data. 
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APPENDIX A 


HARP 


Program Name: 


Function : 


Description : 


Use : 


HARP (HALOE Analysis and Reduction Program) 

HARP is designed to facilitate the processing of 
HALOE test data tapes for performance verification 
and characterization of the HALOE instrument. 

HARP is a segmented program written in Fortran on 
an HP-1000 computer. At various stages of 
development and usage, HARP has had segments which 
were used to plot parameters on different output 
devices, to do Fourier analysis and to calculate 
statistical values such as mean and standard 
deviation for data taken at different "cal-wheel" 
positions . 

HARP is invoked on an HP-1000 by typing HARP. The 
program is menu driven and will offer the user 
flexibility in determining input and output files 
and plotter devices. The windowing technique 
offered by HARP greatly facilitates the selection 
and processing of parameters of interest from the 
HALOE data stream during times of interest. 
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HARP'O OPTS: 


FORMAT-; A 1 
DO 101 1=1,6 
I BT I M< I >= 0 

I F< I ANS . HE . 1 HT , AND . I ANS . HE , 1 HD >THEH 
WRITE-; LULOG, 2 0 02 ) 

GOTO 1 
END IF 

FORMAT-; “ INCORRECT RESPONSE " > 

CLOSE< LU IN ) ! CLOSE WHATEVER WAS OPEN IF ANYTHING 

CLOSE< LUWIN > ! CLOSE WHATEVER WINDOW FILE WAS OPEN 

IF-;' IANS . EQ . 1 HT j THEN 

LU I N=8 ! INPUT WILL COME FROM TAPE UNIT 

WRITE< LULOG, 2 005 i 

FORMAT-; " DO YOU WANT TO USE THE ALTERNATE TAPE DRIVE? < Y/H V* ) 
READ-; LUT, 2001 )IANS 
IF-; IANS . EQ . 1 HY >LUIN=9 

N T A P = 5 ! SET FLAG TO FORCE READ BY REDAT ON 1ST CALL 

OPEN-; LU I N , I OSTAT= IDS , ERR= 1 998 > 

LUWIN = LUIN ! DEFAULT WINDOW FILE IS THE INPUT FILE 
ELSE 


GET NAME OF INPUT DISK FILE 
WRITE< LULOG, 2003) 

FORMAT-;" ENTER NAME OF INPUT FILE -;6A2) ") 

READ-; LUT, 2 0 04 >NAM 
FORMAT-; 6A2 '> 

LU I N=40 i ARBITRARY UNIT HUMBER 

OPEN*; LU I N , I OSTAT= I OS , ERR=1 997 , F I LE=HAM ) 

LUW I N=LU I N ! DEFAULT WINDOW FILE IS INPUT FILE 

END IF 

GOT0 1 ! END OF OPTION 1 


SELECT TIME WINDOW AND CREATE WINDOW FILE 


CONTINUE 

WRITE-;' LULOG, 201 9 ) 

FORMAT-;" REWIND THE INPUT FILE? Y/N" > 

READ-; LUT, 2001 )IANS 

IF< IANS . EQ . 1 HY )REWIND< LUIN ) 

WRITEC LULOG, 2020) 

FORMAT-; " DO YOU WANT TO SPECIFY START & STOP TIMES < Y/N " > 
READ-; LUT, 2001 HANS 

IF< IANS.EQ. 1HN:>GOT0250 ! PROCESS FROM CURRENT TIME 

CONTINUE 

CALL GETIM-; LUT, LULOG, ISTAR, I STM, IER> 

IF-; IER.EQ. 0 >G0T02 05 
WRITE-; LULOG, 2 021 > 
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FORMATS" DO YOU WANT TO RE-ENTER C V / N ) ? " ) 

READC LUT, 2001 )IANS 
IF< IANS.EQ. 1 HY >G0TQ2 04 

GOT0 1 ! ABORT THIS OPTION 

CONTINUE 

CALL GET I MC LUT , LULOG , I END, IETM, IER) 


1 74 
175 
1 76 
1 77 
1 78 
1 79 
180 
181 
182 
1 83 
1 84 
1 85 
1 86 
187 
1 88 
1 89 
19 0 
1 91 
1 92 
1 93 
194 
1 95 
1 96 
1 97 
1 98 

1 99 

2 0 0 
201 
2 02 
2 03 
2 04 
2 05 
2 06 
2 07 
2 08 
2 09 
2 1 0 
21 1 
212 

213 

214 

215 
2 1 6 
217 
2 1 8 
£ 1 9 
22 0 
22 1 


C 


2 06 


25 0 
2 025 


252 
2 026 
C 


2 032 


26 0 


C 

2 029 
C 


2 036 
28 0 


NOW PUT START AND STOP TIMES INTO EMA COMMON ARRAYS 1ST & IET 


DO 206 1=1,6 
I ST C I )=ISTMC I > 

I ET< I >= IETMC I > 

CALL REDATC IEQF, 1 ) ! READ FIRST RECORD 

I FC I EOF >THEN 
WRITER LULOG, 2032) 

GOTOI 
END IF 

IFC IER.EQ. 0 >GOT 028 0 
WRITE-: LULOG, 2 021 ) 

READ*: LUT, 2001 HANS 

IF< IANS.EQ, 1HY)GOT0205 

GOTOI i ABORT 

WRITE-: LULOG, 2 025 > 

FORMAT C " DO YOU WANT TO EXTRACT DATA STARTING AT ",/, 

*“ CURRENT POSITION OF INPUT FILE? <Y/N>" ) 

READC LUT, 2001 HANS 

IF< IANS.EQ. 1HN)G0T01 ! ABORT 

DO 252 1=1,6 

I STMC I >=IBTIM< I ) 

WRITEC LULOG, 2026) 

FORMAT-:" ENTER NUMBER OF HOURS , M I NUTES & SECS TO PROCESS",/, 
*" IN THE FORM HH,MM,SS < THREE INTEGERS SEPERATED BY COMMAS ) " > 


READ-: LUT , * ) I HR , MH , I SEC 

CALL REDATC IEOF, 1 ) ! READ FIRST RECORD 

IF-: IEOF HHEN 
WRITE< LULOG, 2032) 

FORMAT-:" INPUT FILE AT EOF, ABORTING "> 

GOTOI 
END IF 

DO 260 1=1,6 
ISTM-: I >= I BT I M< I > 

SEC= I SEC 

CALL ADT I MC I STM , I HR , MN , SEC,IETM> ! CALCULATE ENDING TIME 

WRITE-: LULOG, 2 029) 

FORMAT C " START, STOP TIMES : " , // ) 

CALL CNVTM-:' I STM, I TIME ) 

WRITE< LULOG, 2036)1 TIME 
CALL CHVTM-: IETM, I TIME) 

WR I TEC LULOG , 2 036 ) I T I ME 
FORMAT-: 2X, 1 3A2 ) 

CONTINUE 

WR I TEC LULOG , 2 03 0 ) 
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222 

2 0 3 0 

223 


224 


225 


226 

2 03 1 

cl c? r 


228 


229 

288 

23 0 


231 

2 037 

232 


233 


4 


235 


236 
2 3 3 


238 


239 

c 

240 

289 

241 


£42 

286 

243 


244 


245 

287 

246 


2 4 f 

2 049 

248 


249 

295 

25 0 


e. 1 

299 

252 

2 035 

£53 


2.54 

C 

255 

C 

256 

3 0 0 

ZT — 3 
cL i 

C 

•“ cr o 


d JO 

L- 

259 

c 

26 0 


2 6 1 


262 


263 


264 

c 

265 

c 

2 66 

c 

267 


268 

c 

269 

c 

2 7 0 

c 

271 

c 

ct \ cL 

c 

i •— t —i 

d i* ^ 

4 0 0 

274 

c 

“7 ET 


d \ J 

--- 

cd »■' b 

r 


HARPG OPTS: 


S : 5 0 AM WbD , , 2 0 MAY , 1987 


F 0 R M A T < " D 0 V 0 U WANT TO S PEC IF V H A M E OF W I N D GW FILE < Y / N > " ) 

READ-; LUT, 2001 >IAMS 

IF< IAHS.EQ. 1 HN )G0T0288 

WRITE< LULOG, 2 031 ) 

FORMAT-:" ENTER WINDOW FILE NAME <6A2>” > 

READ< LUT, 2004 >NAM 
LUW I N= 0 

IF<LUWIN.EQ.42>THEN 
WRITE< LULOG, 2037) 

FORMAT-: " APPEND TO WINDOW FILE IN USE? Y/N "> 

READ-: LUT, 2001 HANS 
IF-: IANS.EQ, 1 HY )G0TG289 
CLOSE-: LUW IN > 

ELSE 

LUW I N=42 ! IN ANY EVENT, A NEW WINDOW FILE IS LU 42 

OPEN-; LUW IN, IOSTAT = IOS, ERR=299, FILE=HAM, STATUS= 'UNKNOWN ' > 
END IF 

CALL SEEK< ISTM, IERR > 

IF-: IERR.GT, 0 :>G0T0299 

CALL REDATC IEOF , 0 ) ! ZERO INDICATES ALL RECORD TYPES 

I F< IEOF )G0T0295 

I F-: CKTM< IBTIM, IETM > >287 , 287 , 295 

WRITE<LUWIN,ERR = 299 >ITYPE, IPWR, IBTIM, IBUF, JDUM, IANHK, ISTAT 
WRITE< LULOG, 2049) 

FORMAT < " STORING DATA IN WINDOW FILE”) 

G0TO286 
REWIND-: LUW IN) 

GOT0 1 

UR I TE-: LULOG ,2035) IERR , LUW I N 
FORMAT-:" ERROR# " ,15," ON LU# " ,15) 

GOTO 1 


CONTINUE 

SELECT PARAMETERS TO PROCESS 
MAXP=1 6 

CALL PRAMS-: MAXP , I ER > 

CALL XTRAC< 8 ) ! EXTRACT SELECTED VALUES 

IF-: IER . NE . 0 )GOT0 1 

INSERT DISPLAY OF PARAMETERS CHOSEN HERE.. 

GOTOI 


CONTINUE 

PLOT SELECTED PARAMETERS 
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o 

277 

c 

d £> 


O T Q 
cl i y 


28 0 

5 0 0 

281 


282 


283 

501 

284 


285 

6 0 0 

2 b 


237 

6 001 

288 


289 


29 0 


291 


292 

6 0 02 

293 


294 


295 

601 

296 


297 


298 


299 

6 02 

3 00 


301 


3 02 


3 03 


304 


3 05 

6 099 

3 06 


307 

6 098 

3 08 


3 09 

65 0 0 

31 0 


31 1 

65 01 

312 


313 

6 5 0 2 

314 


315 


31b 


317 

6 0 03 

3 1 8 

7 00 

3 1 9 


3 2 0 


321 

7010 

322 


323 


324 


325 

7 01 

326 


O c~ i 

7 02 

cC C' 

710 0 

329 

7 01 1 


33 0 
331 


HARPO OP i S : 


i'!H Y 


t b o 


CALL 3EGLD-; HARP 1 , I ERR ) 

G0T01 

CONTINUE 

CALL SEGLD-: HARP2 , I ERR > 

IF-: IERR.NE, 0 )WRITE< LULOG, 501 >IERR 

FORMAT 1 ' " ERROR SCHEDULING HARP2 SEGMENT , ERR# = ”.I5> 

GOT 0 1 

CONTINUE 


WRITE-: LULuG .,6 001 > 

FORMAT-:" FORWARD OR REVERSE SEARCH? F/R > " > 

READ< LUT, 2 001 >IANS 
IF>: IANS , EQ . 1 HR >GGTG65G0 
IF< IANS . NE . 1 HF >THEH 
WR I TE< LULOG ,6002 > 

FORMAT<" INVALID RESPONSE!") 

GOTOI 
END IF 

READ<LUIN,END=6099,ERR=6G98)ITVPE,< INBUF< I )., 1 = 1 ,4), IBTIM 
CALL CNVTM< IBTIM, ITIME ) 

WRITE-: LULOG, 6003>ITIME 
I F C I FBRK< KK ) > 1 ,602,1 
I F< I TYPE , NE . 3 )G0T06 0 1 
BACKSPACE-: LUIN) 

READ-: LUIN)I TYPE, < INBUF< I >, 1 = 1 , 4 ), IBTIM, I NOTE 
CALL CHVTMC IBTIM, ITIME) 

WR I TE< LULOG , 6 0 03 ) I T I ME , I NOTE 
GOT0601 

WRITE< LULOG, '< " END OF INPUT FILE")') 

GOTOI 

WRITER LULOG, '< " ERROR ON INPUT FILE")') 

GOTOI 


BACKSPACE*: LUIN ) 

BACKSPACE-: LUIN) 

READ<LUIN,END=6099, ERR=6 098 ) I TYPE, < IHBUF-: I ), 1 = 1 , 4 ), IBTIM, I NOTE 

if-: ifbrk-:kk>)i ,65 02, 1 

IF< I TYPE . NE . 3 )GOT065 00 
CALL CNVTM< IBTIM, ITIME) 

WRITE-: LULOG, 6 0 03) ITIME, I NOTE 
GOTO6500 

FORMAT-; IX, 13A2,2X,3SA2) 

CONTINUE 
I SEC= 0 


WRITE-: LULOG, 701 0) 

FORMAT-://," 1 = SELECT PRINT FREQUENCY 
* u 2 = PRINT SELECTED PARAMETERS “ ,/, 

+ " 3 = PRINT IN SELECTED DISPLAY FORMAT" 
*" 4 = RETURN TO MAIN MENU") 

READ-: LUT , + ) I ANS 

IF< ICHKC IANS, 1 , 4) >701 ,702,701 
GOTO-: 71 00, 7200, 7300, 1 >IAHS 
WRITE-: LULOG, 701 1 ) 

FORMAT-: " ENTER PRINT FREQUENCY ",/, 

*" 1 = EVERY SECOND",/, 

*" 2 = EVERY 2 SECONDS. . .ETC. " ) 
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READ<LUT,+>ITDEL 
GOTO? 0 0 
CONTINUE 
MAXFRG= 1 
MAXP= 1 6 

CALL PRAMSCMAXP, IER) 

CALL XTRACX MAXFRQ > 

DO 7 06 KK= 1 , I DCNT 
IC-: KK )=1 
DO 7 03 K K = 1 
I TBUF< KK )= I ST < KK > 

I TBU2< KK >= I ET< KK ) 

CALL CNVTM< ITBUF, I TIMS) 

CALL CNVTM< ITBU2, I TIME) 

WRITE< LUPR, 70 00 > ITIMS, 

+ < < MQN< KK , LL ), KK=1 , 4 ),LL=1 , I DCNT > 

I L I NE = 0 

I L I NE= I L I NE + 1 

I F< ILINE . GT . 50 :>GOT07 04 

I HR= 0 

MN = 0 

SEC=FLOAT< I SEC )* 1 . 024 

CALL ADTIMCITBUF, IHR,MN, SEC,ITBU2) 

CALL CNVTM< ITBU2, ITIMS) 

WRITECLUPR, 7001 ) JT I MS , < DAT< IND< ICC NP ) , NP ) > , NP= 1 , IDCNT) 
FORMAT < 1 H 1 , ,V,27X, 13A2,//,14X, 16<2X,4A2)) 

FORMATS 1 X .. 7A2 , IX, 16E1 0.4) 

DO 710 KK= 1 , I DCNT 
ICC KK )=ICC KK )+ITDEL*MAXFRQ 
IFC ICCKK).GT.NPTCKK))G0T01 
CONTINUE 
ISEC=ISEC+ITDEL 
IF< IFBRKC KL > >1 ,705,1 
CONTINUE 
CALL RDISP 
CONT I NUE 
CALL PRDSCIEOF) 

IFC I EOF >GOTO 1 

IF< ITDEL.GT. 1 >CALL SKIPYCLUIN, ITDEL, I EOF , LULOG , NT AP ) 

IF< I EOF >GOTO 1 

IFC IFBRKC KL ) >1 , 7301 , 1 


CONTINUE 

JF I R= 0 ! SET FLAG TO ACQUIRE BEGIN TIME 

CALCULATE VARIOUS STATISTICAL VALUES 
UR I TE< LULOG, 8 000) 

FORMATC // " 1 = STATS ON ALL SCIENCE DATA " , X , 

* " 2 = STATS ON SELECTED PARAMETERS 

* " 3 = RETURN TO MAIN MENU") 

READC LUT, * ) I ANS 

GOTOC 81 0 0, 82 0 0, 1 >IANS 

CONTINUE ! STATS ON ALL SCIENCE DATA 

I DCNT = 1 2 

ORIGINAL PALL 33 
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I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 


388 

389 

390 

391 

392 

393 

394 

395 
39b 

397 

398 

399 
4 00 
4 01 
4 02 
4 03 
4 04 
4 05 
4 0 6 
407 
4 08 
4 09 
41 0 

41 1 

412 

413 

414 

415 

416 

417 
4 i 8 
419 

42 0 

421 

422 

423 

424 

425 
4 26 

427 

428 

429 

43 0 

431 

432 

433 

434 

435 

436 

437 

438 
4 3 9 

44 0 
441 


8 07 


82 0 0 


8 08 


8 09 
8 1 0 


81 


! 1 6 


815 


82 0 


8 0 05 


I 
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IDM< 1 )= IDGEK 8HN0V 
IDN<2>= IDGEK 8HN0DV 
I DN<: 3 >= I DGEK 8HHCLV 
I D H < 4 > = IDGEK 8HHCLDV 
IDN<b) = IDGEK 8HHFV 
I DN< 6 )= IDGEK 8HHFDV 
I C>M< 7 >= IDGEK 8HCH4V 
I DN< 8 )= IDGEK 8HCH4DV 
I DN< 9 )= IDGEK 8H03V 
I DN< 1 0 >= I DGET< 8HC02V 
I DN< 1 1 >=IDGET< SHNG2V 
I DH< 1 2 >= I DGEK 8HH20V 
DO 807 1=1,12 
CALL IDMOV< I > 

I FREQ< I >=8 
MPTS< I > = 0 
CONTINUE 
GOT0308 

CALL PRAMSC 16, IER > 

I F< IER . NE , 0 )GOTO 1 
CONTINUE 

DO 809 1=1, IDCNT 
SUMX< I ) = 0 . 

SUMX Cl >=0.0 
XMIN< I >= 1 , 0E20 
XMAXC I >=-1 . E2 0 
MPTSC I )=0 
CONTINUE 

CALL REDAK IEOF, 1 > 

I F< IEOF >G0T032 0 
IF< JFIR.EQ, 0 >THEN 
JFIR=1 

DO 817 K = 1 ,6 
I STM< K 1>= I BT I N< K ) 

END IF 

DO 315 K=1, IDCNT 
DO 316 L= 1 , IFREGK K ) 

I D= I DN< K ? 

I C N T R = 0 


.i 

> 

> 

> 

> 

} 

) 




> 

> 

) 


ACQUIRE BEGINNING TIME 


I DAT= I GET < ID, L, ICNTR , V > 

SUMX< K )=3UMN< K >+V 
SUMX2< K >=SUMX2< K >+V*V 
I Ft V . LT . XM I N< K > )XM I N< K )=V 
IF'1 V , GT . XMAX< K > )XMAX< K >=V 
CONTINUE 

MPTS< K )=MPTS< K ) + I FREQ< K > 

CONTINUE 

NPTS=NPTS+8 ! NUMBER OF POINTS SUMMED SO FAR 

I F< IFBRK<KK) >82 0, 81 0,82 0 

CONTINUE 

I Ft NPTS , EQ , 0 >THEN 


UR I TE< LULOG , 80 05 ) 

FORMAT t " NO DATA OR EOF ENCOUNTERED IN INPUT FILE":> 


GOTOI 
END IF 
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I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 

I 
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44; 

44: 

444 

445 
4 46 

447 8001 

448 
4 49 
4 5 0 

451 

452 

453 

454 

455 

456 

457 

458 

459 
4 6 U 

461 

462 

463 

464 

465 

466 

467 

468 

469 
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1 98 / 


" 1 3A2 , / > 


! 0 02 


MAX- MIN" , 
"// ) 


DO 321 K= 1 , 6 
I ETM< K >= I BT I M< K ) 

CALL CHVTMC I STM, I TIMS > 

CALL CNVTM< IETM, I TIME? 

WRITE< LULOG, 8001 )ITIMS, I TIME 
FORMAT-: /X” START : " , 1 3A2, 5X, " STOP 
I F< LUPR , ME . 0 >THEH 
WRITE-: LUPR, -< 1H 1)') 

WR I TE-: LUPR , 8 0 0 1 ) I T I MS , I T I ME 
WRITE< LUPR, 8 0 02 > 

END IF 

WRITE-: LULOG, 8 002) 

FORMAT-: //" NAME MINIMUM MAXIMUM 

+” MEAN VARIANCE STD DEV #PTS 

DO 830 1=1, IDCNT 
PTS=FLQAT< MPTS< I )) 

XMEAN=SUMX< I )/PTS 

VAR = < PTS + SUMX2-; I )-SUMX< I )+SUMX< I ) )/< < PTS-1 , DO >*PTS ) 

I F< VAR . GT . 0 . 0 )SD=DSQRT< VAR > 

D I FF=XMAX< I )-XMIN< I ) 

IF< DIFF . EQ . 0 . 0 )THEN 
VAR= 0 . 0 
SD = Q . 0 
END IF 

WRITE< LULOG, 8 003 >< MOH< ,1,1, I ), ,l.j=1 , 4 >, XMIHC I ), XMAX< I >, DIFF , XMEAN 
* , VAR, SD, MPTS< I ) 

I F< LUPR , NE , 0)WRITE< LUPR, 8003 KMOH-: JJ, I ), JJ=1 ,4),XMIN< I ),XMAX< I ), 
*D I FF , XMEAN , VAR , SD , MPTS< I ) 


470 

8 0 03 

FORMAT < IX, 4A2, 5< E 1 0 

471 

830 

CONTINUE 

472 


GOT0 1 

473 

398 

CONTINUE 

474 


WR I TE< LULOG , 8 004 > I OS 

475 

3 0 04 

FORMAT-: " ERROR # ” , 

476 


GOTOI 

477 

9 0 0 

CONTINUE 

478 


WRITE-: LULOG, 9 001 ) 

479 

9 0 0 1 

FORMAT-: " DO YOU WANT 

4 8 0 


*/," < FOR CAL-WHEEL, 

481 


READ-: LUT, 2 001 )IANS 

432 


I F< IANS . EQ . 1 HN )GOT0 1 

483 

901 

CALL GETIMC LUT, LULOG 

484 


IF-: IER . NE . 0 )THEN 

485 


WRITE< LULOG, 2021 ) 

486 


READ-: LUT, 2 001 HANS 

487 


IF-: IANS , EQ . 1 HN >GOT0 1 

488 


GOT0901 

4 y 9 


END IF 

49 0 


CALL Rt DAT< IEOF, 1 ) 

491 


IF< IEOF )THEN 

492 


WRITEC LULOG, 2032) 

493 


GOTOI 

4 94 


END IF 

4 y 3 


CALL SEEK< I STM, I ERR ) 

49b 


IF< IERR.NE. 0) GOTO 9 09 


*»y n.i-’i'i 
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521 

9 010 

! ■ 522 


® 523 


524 

9 011 

■ 525 
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w* cl >' 
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■ 529 


53 0 

9 013 

531 


'1 532 


■ 533 
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534 


■ 535 


| 536 


537 

9 099 

53£( 


1 539 

9 0 02 
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10 0 0 
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■ 542 
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• 543 


544 


• 545 


| 546 

1 0 02 

547 


— 548 


■ 549 


■ 55 0 
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MAXP=23 

CALL PRAMS< MAXP, IER ) 

IF< IER .HE, 0 )GOTO 1 
WR I TEC LIJLOG ,9003) 

FORMAK " ENTER NAME OF PARAMETER FOR STUDY",/, 

+ "C33 FOR CAL WHEEL: STATUS 2 FOR I FOV , SPECTRAL RESPONSE" - ; 

READ-; LUT ,20 04 >NEMO 
I DNUM=IDGET< NEMO ) 

I F< IDHUM)91 0,91 0,92 0 
WRITECLULGG,9004) 

FORMAT-: " NOT WHAT I WAS LOOKING FIR, , , ” ) 

GOTOI 

DO 930 1=1, IDCNT 
NPAR= I 

IF-: IDNIJM . EQ . IDNC I ) )GGTG950 

CONTINUE 

I DCNT= IDCNT + 1 

I DH( IDCNT )= IDNUM 

DO 932 1=1,4 

NONCK, IDCNT )=NEMOC I ) 

CONTINUE 
NPAR= IDCNT 
CONTINUE 

WRITER LULOG, 901 0) 

FORMAK" ENTER SHORT DESCRIPTIVE NAME FOR PARAMETER",/, 

*" SUCH AS: SLIT POSITION OR WAVENUMBER OR CAL POSITION ETC." - ) 
READ*: LUT, 901 1 )IDESC 
FORMAT-: 1 0A2 ) 

WRI TEC LULOG ,9012) 

FORMATC " ENTER # OF SECONDS < MAJOR FRAMES ) OF DATA TO "./, 

*" PROCESS AT EACH LEVEL OF THE PARAMETER" - .) 

READC LUT , * )HFRAM 
WRITEC LULOG, 901 3 > 

FORMAT-: " ENTER MINIMUM # SECONDS ACCEPTIBLE AT EACH LEVEL") 
READC LUT, *)M INF 
WR I TEC LULOG, 901 4 > 

FORMATC" ENTER MAXIMUM # LEVELS TO PROCESS" ) 

READC LUT , * )MVAL 

CALL PMETC NFRAM, MINF, HPAR, MVAL , LUPR, IDESC, I STM > 

GOTO! 

WRITEC LULOG, 9 0 02.) I ERR 
GOTOI 

FORMATC » ERROR #",I5) 

CONTINUE 

WRITEC LULOG, 1001 ) 

FORMATC" DO YOU WANT TO EXECUTE A COMMAND FILE? (Y/H)") 

READC LUT, 2001 >IANS 
IFC IANS , EQ . 1 HN )G0T01 
WRITEC LULOG, 1 002) 

FORMATC" ENTER NAME OF COMMAND FILE") 

READC LUT, 2 0 04 )NAM 
CLOSEC LUT > 

LUT=4 1 

OPEN-; LUT, I OSTAT= I OS , ERR= 1 999 , F I LE=N AM ) 

UUT01 ORIGINAL PAGE IS 
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552 1100 
C 

C 11 0 1 
C 
c 
c 

C11 02 
C 
C 

1 2 0 0 


554 

555 

556 
55 ? 

558 

559 

560 

561 
■-*62 
563 
5*64 

565 

566 

567 

568 

569 

57 0 

571 

572 

573 

cr "7 .i 
■_* f 4 

C7C 

i .„* 

576 

57 ? 

:*78 

579 

58 0 

581 

582 
533 
584 


1 202 

1 2 03 
12 04 


1 299 
1 298 


130 0 
1 997 


1 9 9 8 


1 

I 


586 1 999 


539 
59 0 
59 1 
5 92 


2100 

2101 


I 

f 

I 


CONTINUE 

WRI TEC LULQG, 1101) 

FORMATS " DO YOU WANT TO CHANGE THE LIST LU? <Y7N>") 
READC LUT , 2 0 0 1 HANS 
IF< IANS.EQ, 1 HN )GOTO 1 
WRITE*;' LULOG, 1 1 02 ) 

FORMATC" ENTER LU <6=PRINTER. 1 OR 12 = SCREEN , O = 
READC LUT, * >LULOG 
GOT0 1 

CONTINUE ! TREND SNAP-SHOT 

WRI TEC LULQG, 12 01 ) 


1201 FORMATC “ DO YOU WANT TO SAVE A SNAP-SHOT? Y/N‘ 


READC LUT , 2001 HANS 
IFC IANS, HE. 1 HY )GQT01 
WRI TEC LULQG, 1202) 

FORMATC "ENTER TREND FILE NAME”:) 

READC LUT, 20 04 >NAM 

OPENC UNI T=2 0, I OSTAT= I OS , ERR= 1 299 , F I LE=N AM ) 

READC 2 0 , ERR= t 299 ,END=1204 > 

GOTO1203 

WRI TEC 20, ERR=1 299 > I TYPE, IPWR, IBTIM, IBUF, IDUM, I AHH1C I 
CLOSEC 20) 

GOTOI 

WR I TEC LULQG , 1 298 ) I OS , NAM 

FORMATC" ERROR # ",I5," ON FILE " , 6A2 1 

CLOSEC 20) 

GOTOI 

STOP 

LUT=LOGLUC IDUM ) ! RESET LUT TO TERMINAL 

WRI l EC LULOG . 2 1 00>IuS,NAM 

GOTCU 

LUT=LOGLU< IDUM) 

WRITEC LULOG, 21 Ut )IuS 
GOTOI 

LUT=LOGLUC IDUM > 

Wk I TEC LULOG ,2102>I OS 
GOTOI 

FORMATC " ERROR # «,I5,2X,” FILE NAME ;».6A2) 
FORMAT*;" ERROR # M5,2X," WITH MAG TAPE ") 

FORMATC" ERROR # ",I5," WITH COMMAND FILE “ > 

END 


FTN4X COMPILER; HP92S34 REV. 2130 <81 0716) 




I 


hO WARNINGS ** NO ERRORS ** PROGRAM: 4881 


COMMON 


I 


HONE" ) 


STAT 


original: page is 

OF POOR QUALITY, 



8:50 AM WED , 



CTO "7 

sJ 

1 594 
595 
596 
597 
598 
5 99 
6 00 
601 
6 02 
6 03 

1 6 04 
6 05 
6 06 



1 6' 07 
6 08 
6 09 
fc> 1 0 




61 1 
£•12 




6 1 3 

614 

615 
£• 1 6 

617 

618 
6 1 9 
620 
£■2 1 
622 

623 

624 

625 

626 
627 

6 Q< 

629 
63 0 
63 1 


6 d 
A •$ -i' 




b 

6 

6 


4 

£7 

6 


637 

638 

639 
6 4 U 

1 6' 4 1 
642 
643 
6 44 
A. b 
6 4 6 
647 

I 

I 




12 Fin. GPiSj LyI 


M A Y i y y / 


fEMAC XY2, CO 

SUBROUT I HE PMETC NFR AM , M I NF HP AR , MVAL , I PRT , I DESC , I STM > 

COMMON/ 1 DAT / 1 BUFC 256 ) , I FLAG , I BT I M< 6 > .. ISTATC 1 0 > , I ANHKC 24 ), IPWRC 4 > 
COMMON LUT,LULGG,LUIN,LUWIH,NTAP, INBUFC 1 0),LBUF< 151 0 >, LUPR 
COMMON /XYZ/DAT C 16384 ),HPTC 16), IDCNT , ISTC6), I ETC 6 ) .• MON 1 '. 4, 16), 

* I DNC 16), I TYPC 1 6 ) , I FREQC 16), SUHX2C 16), NPTS 

* , SUMXC 16), XMEANC 16) 

DIMENSION IDESCC 10), ISTMC 6), 1TBUFC 1 3 ), PMEANC 1 6 ) 

LOGICAL I EOF 

DOUBLE PRECISIGN*8 XMEAN , VAR, 3D, SUMX, SUMX2, DIFF 
C 

DIMENSION MPTSC 24 > , NAMPC 6 > 

C 

c 

C THIS ROUTINE PROCESSES DATA AT TIMES WHEN SOME VALUE SUCH 

C AS CAL WHEEL POSITION IS CONSTANT. SLIT POSITION OR SPECTRAL 

C WAVELENGTH ARE TWO OTHER TYPES OF PARAMETERS WHICH CAN BE 

C PROCESSED WITH THIS ROUTINE. 

C 

C NFRAM = DESIRED NUMBER OF FRAMES OF DATA AT EACH LEVEL OR 

C VALUE OF PARAMETER CCAL WHEEL POSITION ETC,) 

C MINF = MINIMUM HUMBER OF FRAMES ACCEPT I BLE AT EACH LEVEL 

C NPAR = ID HUMBER OF PARAMETER BEING STUDIED 

C MVAL = MAXIMUM NUMBER OF LEVELS TO STUDY 

C I PRT = PRINT FLAG < 0= NO PRINTOUT, OTHERWISE PRINT) 

C 

c 


CALL CNVTMC I STM , I TBUF ) 

WRITEC I PRT, 1 1 02) I TBUF, I DESC 
1 1 02 FORMAT 1 ' 1H1 , 15X, 13A2, 1 OX, 1 0A2 ) 

WRITECLULOG, 1 1 03) 

1103 FORMATC “ DO YOU WANT TO CREATE A PLOT FILE? Y/N" 


1 1 04 


READC LiJT, 1 1 04 >IANS 
FORMAT-: A 1 ) 

IF< IANS.EQ, 1 HY >THEN 


i!05 
1 1 06 


1121 


WRITECLULOG, 1 1 05) 

FORMAT*:” ENTER NAME OF PLOT FILE") 

READ-' LUT , 1 1 06 )NAMP 
FORMATC 6A2 ) 

I PFLAG= 1 

OPEHC 20, FILE=NAMP , ERR= 1 120) 

B T I M = ISTMC 2 )+ISTM< 3 )*60 . + ISTMC 4 )*3600 , 
WRITEC 20, 1 121 > IDCNT, ISTMC 6 ), ISTMC 5 ), BTIM 
+ , IDCNT ) 

FORMATC 13, 215, FI 0.3,64A2 ) 

ELSE 

I PFLAG= 0 


C MONC I 


END IF 

UR I TEC I PRT , 1 1 0 0 >< C MONC KK , I > , KK= 1 , 4 ) , I = 1 , I DC NT ) 
110 0 FORMATC // , 4X , 7C 4 A2 , 1 OX ) ) 

H V A L = 0 

DO 5 KL= 1 , 6 

I STC KL )= I BT I M< KL ) 

CONTINUE 


1 = 1,4), J=t 


A-16 


OP i S : 


LYI 


S: 5 0 AM WhD, 


2 0 MAY 


1 98 .-' 




ALL 

1 3 

6 4 8 

1 

649 


65 0 


651 


652 


653 


654 


6 5 5 

c 

656 

c 

657 


658 

1 0 

659 


6 6 u 


66 1 


662 


663 


6 6 *4 

2 0 

665 

c 

666 


667 


668 


6 6> 8 


67 0 


6 7 1 


-n.-. 


t> i' cL 

L- 

673 

c 

6 7 4 

9 0 

6 < 5 


676 

1 0 0 

677 


678 


679 

3 0 

68 0 


68 1 


O c_ 

1 0 0 0 

666 


6 y 4 


685 


686 


687 


b y 8 


A P p 


6 9 0 

1 0 0 1 

69 1 


692 


693 

2 0 0 

694 


695 


696 

2 1 0 

697 


6 93 

C 

6 99 


7 0 0 


701 





A Pit i 


I F< HVAL , EQ . MVAL > G0T023 0 


NVAL = HVAL +1 
I FRAM=0 ! 

DO 10 I=J,IDCNT 
SUMX< I >= 0 . 
SUMX2< I > = 0 , 
XMEAN< I > =0, 

X M I N < I >=1 , E2 0 
XMAX< I > =-1 , E20 
MPTS< I >= 0 


LOCAL COUNTER FOR # FRAMES AT CURRENT LEVEL 

! INITIALIZE SUM TO ZERO 
! INITIALIZE SUM X SQUARED TO 0, 

! I HIT SUM OF SQUARES 
! INI T MIN VALUES 
! I NIT MAX VALUES 
! I HIT NUMBER OF PTS FOR EACH ID 


CONTINUE 


I CNTR= 0 


IPAR=IDN< NPAR ) 

IDAT=IGET< I PAR, 1 , I CNTR, V ) 
V AL=V 


DAT< IND< HVAL, NPAR > >=V ! GET NPAR PARAMETER 

DO 100 K= 1 , IOCNT 

IF< I DN< K ) . EQ . I PAR >GQTQ 1 0 0 

DO 9 0 L=1 , IFREQCK ) 

I D = I DN< K) 

I C N T R = 0 


IDAT = IGET< I D , L , I CNTR , V > 

SUMX< K >=SUMX< K )+V 
SUMX2< K >=SUMX2< K >+V*V 
I F< V . L T . XM I N< K > )XM I N< K )=V 
I F< V . GT . XMAX< K > YXNAX-: K >=V 
CONTINUE 

MPTS< K >=MPTS< K )+IFREG< K > 

CONTINUE 
IFRAM=IFRAM+1 
I F< IFRAM . EQ . NFRAM >GOTO2O0 
CALL REDATc IEOF, 1 > 

IF-: I EOF )THEN 
WRITE* LULuG, 1 000) 

FORMAT < " EOF ENCOUNTERED IN INPUT FILE' 1 ) 

GOT0230 
END IF 
I CNTR= 0 

IDAT=IGET< I PAR, 1 , I CNTR, V > 

I F < V . EQ . VAL )GOT 02 0 

IF< IFRAM. GT.M INF )G0T02 0 0 ! FINISHED THIS LEVEL 

URITE< LULOG, 1 001 ) IFRAM, VAL ! NOT ENOUGH POINTS 

FORMAT-: " FOUND ONLY " ,15," FRAMES AT LEVEL =" ,E12.4) 
NVAL =NVAL- 1 
GOT0 1 

CONTINUE 
DO 210 KL= 1 ,6 

iet«:kl)=ibtim<kl) 

CONTINUE ! GET ENDING TIME 

DO 22 0 1= 1 , I DC NT 
IF-: IDN< I ) . EQ . I PAR )GOT022 0 
PTS=FLQAT<MPTS< I ) ) 

XMEAN-: I )=SUMX< I )/PTS 
PMEAH-: I ) = XMEAN-: I ) 

VAR=< PTS*SUMX2< I >-SUMX< I >*SUMX< I > )/< < PTS-1 . DO >*PTS ) 


A- 17 


PMEI 


OPTS 


LYI 


i 987 


1 4 


0 AM 


WED., 20 



7 i 



1010 

225 


I F< VAR ■ GT . 0 , DO >THEN 
SD=DSQRT< VAR > 

ELSE 
SD = 0 . 0 

DIFF=XMAX< I )-XMIN< I ) 

IF< DIFF . EQ . 0 . )THEN 
V AR= 0 . 0 
SD=G . 0 
END IF 

SUMX< I )=SD 
CONTINUE 
IF< IPFLAG.NE. 0) 

*WR I TE< 2 0 >BT I M , < PMEAN< K > , K=1 .1 DC NT ) 

I F< LUPR . NE . 0) 

*WR I TEC LUPR , 1 0 l 0 X < XMEAN< K ), SUMX< K > > 
FORMATS IX, 14<F9,4>:> 

CONTINUE 

CALL REDAT< IEOF, 1 ) 

I F< I EOF >G0T0230 
I CNTR= 0 


2-i 



73 0 



I DAT = I GET < I PAR, 1 , ICNTR,V> 

I F< V . EQ . VAL )G0T0225 
VAL = V 
GOT0 1 

23 0 CLOSED 2 0) 

RETURN 

1120 WRITER LULOG, 1119) 

1119 FORMAT* "ERROR OPENING PLOT F I LF 11 > 
RETURN 
END 


COMPILER; 


HP92834 REV. 21 30 <810716 > 


1 


K'= 1 


22 0 


I DC NT) 


MAY , 


NO WARNINGS ++ 


NO ERRORS ** PROGRAM; 


COMMON i 


1526 



LYI 


PAGE 15 FTH, 


OPTS: 


8; 50 AM WED,, 20 MAY , 1987 


734 

73 ,= i 

73fa 

737 

738 

739 

74 0 

741 

742 

743 

744 

745 

746 

747 

748 

749 

75 0 

751 

752 

753 

754 


SUBROUTINE ADT I M< I STM , I HR , MN , SEC,IETM> 

DIMENSION I STM< 6 ) , IETM<6 ) 

I SEC=SEC ! TRUNCATE VALUE OF SECONDS 

RSEC=SEC-FLOAT< ISEC > 

JSEC=RSEC* 1 00 

IETM< 1 > = 1 3TM< 1 >+ JSEC ! SET ENDING .01 SECS TO STARTING VAL 

ICARY=IETM< 1 )/ 1 00 

IETM< 1 )=MOCX IETMC 1 ), 1 00 > 

I E T M < 2 ) = I STM< 2 )+ 1 SEC+ 1 CARY ! ADD SECONDS TO STARTING SECS 

I CARY = I ETM< 2 >76 0 ! CALCULATE CARRY FOR MINUTES 

I ETM< 2 ) = MOCK I ETM< 2 >,6 0 > ! MOD MINUTES TO INSURE < 6 0 

I E T M < 3 > = I STM< 3 > + MN + ICARY ! CALCULATE MINUTES 

ICARY = I ETM< 3 >760 ! CALCULATE CARRY FOR HOURS 

I ETM< 3 > = MOCK IETM< 3 >, 6 0 > ! ADJUST MINUTES < 6 0 

IETMC4) = I STM( 4 ) + I HR + ICARY ! CALCULATE HOURS 

ICARY = IETM< 4 >/24 ! CALCULATE CARRY FOR DAYS 

IETMC4) = MOD< IETM< 4 ), 24 ) ! INSURE THAT H0URS<24 

IETMC 5 > = I STM< 5 > + ICARY ! CALCULATE ENDING DAY 

IYMGD = 365 ! SET # DAYS IN YEAR 

IF< MOCK ISTM< 6 >, 4 > , EQ , 0 > IYMOD= 366 ! CHECK FOR LEAP YEAR 

ICARY = IETM< 5 VIYMOD ! CALCULATE YEAR CARRY 

IETM< 6 > = I STM< 6 > + ICARY i ENDING YEAR 

RETURN 

END 


FTH4K COMPILER; HF‘92834 REV. 21 30 (81 0716 ) 


•+ +' 


NO WARNINGS ** NO ERRORS ** PROGRAM 


1 78 


COMMON: (NONE 


ORIGINAL PAGE IS 
OF POOR QUALITY 


A- 19 



PAQt 16 t-lN. OPiS: LYI 8:5U AM WbD . , 2 0 MAY , 1987 


/ l o7 t E M h < X Y Z 0 ) 

758 SUBROUTINE IDMOVu'ID) 

759 COMMON /XYZ/DAK 1 6384 > , NPT< 1 6 > , I OCNT , 1ST < 6 > , I ET < 6 > , MON< 4 1 6 > , 

76 0 * I DNC 1 6 ) , I TVPC 1 6 ), I FREQC 16), XM I H( 1 6 > , XMAX< 1 6 > , NPTS 

7 61 + , SUMX< 1 6 > , SUMX2< 1 6 > 

762 COMMON/ VDT/ 1 VDT< 7 , 2 0 0 > , H I BCK 5 0 0 > , I VDTN< 6 ) , MHE< 4 , 2 0 0 ) 

763 DO 10 1=1,4 

764 1 0 MON*' I , ID )=MNE< I , I DN< ID)) 

765 RETURN 

766 END 


FTN4X COMPILER; HP92S34 REV, 2 130 <810716) 


** NO WARNINGS ** NO ERRORS ** PROGRAM; 50 COMMON; < NONE ) 



pAGh i Fin, OPTS: LYI 


8:50 AM UhD . , 20 MAY , 1987 


? A 7 
7 68 
7 £.9 
77 0 

771 

772 

773 

774 

“7 cr 

> » -J 

77 b 

777 

778 

77u 

> * z* 

78 0 

781 

782 
7 83 

784 

785 


1 0 
2 0 


SUBROUTINE JULINc I DAY, IVR, IM,. IDA ) 

D I MENS I ON I NS< 1 2 > , I DY< 1 3 ) 

I NTEGER*4 IM, IMS 

DATA IMS /'JAN FEB MAR APR MAY JUNEJULYAUG SEPTOCT NOV DEC V 
DATA I DY / 0 , 3 1 ,59,90, 120., 151 , 181 ,212, 243 ,273,304 , 334 , 365/ 

I AD = 0 

IF< I DAY . LT . 60 )GG TO 5 
I ADD = MOD< I YR , 4 ) 

I F< I ADD , EQ , 0)1 AD = 1 

DO 10 1=2,13 

I DC = IDYCI) + I AD 

IF< IDAY.LE. IDOGO TO 2 0 

CONTINUE 

I MH= I - 1 

IDA = I DAY - I DY< I MN ) 

I F< I DY< I MN > . GT , 3 1 ) I DA = IDA - I AD 
IM = IMSxIMN) 

RETURN 

END 


FTN4X COMP ILER : HP92834 REV ,2130 < 8 1 07 1 6 > 


** NO WARNINGS ** NO ERRORS ** PROGRAM: 


COMMON: C NONE > 


i 


A-2 1 


.PAUL 18 F i H . 


OPTS; LVI 


8: 5U AM OLD , , 20 MAV , 


7 a 6 
78? C 
788 C 
f y y 
79 0 

791 

792 

793 1 0 

794 

795 

796 


797 


798 

2 0 

799 


8 00 

3 0 

3 01 

100 0 

8 02 



8 0 3 


SUBROUTINE SKIPYCLUIN, ITDEL, I EOF , LULOG , NTAP > 


SKIP RECORDS IN THE INPUT FILE 
LOGICAL I EOF 
I TER= I TDEL- 1 
DO 10 1=1 , ITER 

READ< LUIN,EHD=20,ERR=30 J I OST AT = I ERR > 

CONTINUE 

NT AP=5 

CALL REDAT< I EOF, 1 ) 

IEOF= .FALSE , 

RETURN 
I EQF= . TRUE . 

RETURN 

WRITE< LULOG, 1 OOOIERR 

FORMAT-;" ERROR # ",15," ON INPUT FILE " > 

RETURN 

END 


JFTN4X COMPILER: HP92834 REV. 2130 <810716) 

+ + HO WARNINGS ** NO ERRORS ** PROGRAM: 84 COMMON: 


CPJ^AU pa-ge m 

w p GJR quality: 


< NONE ) 


A-22 


.PAGb 1 9 

FiN. OPiSi LYI 

8:ou AM WtD . , 20 MAY , 

i 9 y / 

1 

8 04 

SUBROUTINE PRDS 



1 8 05 C 

DUMMY SUBROUTINE 



[ 8 06 

RETURN 



8 07 

END 




f- I H 4 >i COMPILER: HP92834 REV. 21 30 <810716) 

\ 

* + HO WARNINGS ** NO ERRORS ** PROGRAM: 5 COMMON: (NONE.) 


A-2 3 


OPTS : 


LYI 


SO AM WtD , 


A Ub 
8 0S 



BLOCK 

Jblock 


BLOCK 




2 0 LIN, 


n h Y 


i y y i 


BLOCK DATA HADAT 

COMMON/ 1 DAT/ 1 BUF< 256 ) , I FLAG , IBTI M< 6 > , I STATC 10), IAHHKC 24 > , I PWR< 4 
*, I TYPE 

COMMON/ENG/ I ENG 

COMMON/D ISP/ IDD< t 0 0), IDDS< 10), IDDNM< 6, 6 ) 

DATA IENG/2/ 

END 


COMPILER; HP92S34 REV, 2130 <810716) 

HO WARNINGS ** NO ERRORS *+ PROGRAM: < NONE > COMMON: < NONE > 

COMMON DISP SIZE: 146 

COMMON ENG SIZE: 1 

COMMON I DAT SIZE: 302 


ORIGINAL PAGE IS 
OF POOR QUALITY 


A-2 4 


.PAUL 


FTN. 


UFTs : 


LYI 


S; 5 0 AM WED,, 20 MAY , } 987 


815 

816 
8 1 7 
818 
819 
82 0 
821 
022 
8 25 

824 

825 

826 
327 
828 
829 
83 0 

831 

832 
3 33 " 


i : 


1 1 
1 


SUBROUTINE RDISP, READ DISPLAY FORMAT FILE < WLE > 

DIMENSION I F I LE< 6 > 

COMMON/MONTR/ ITCLS, ITLEN, ISBUFC 92 0 > 

COMMON/ VDT/ I VDTC 7 , 2 0 0 ) , NIBDC 5 0 0 ) , I VDTNC 6 ) , MNE< 4,200) 
COMMON/D ISP/ I DDC 100), IDDSC 10), I DDNM< 6,6) 

COMMON LUT , LULOG , LUI N , LUWIN , NTAP , INBUFC 1 0),LBUF< 151 O.LUPR 
COMMON/MSK/ MASKC 16) 

DATA I FILE/- ;DS:22V 

MXIDD = 100 
L U B D = 20 
LUDIR = 21 

CALL FMTDRC LULOG, LUDIR, IDBNM) 

WR I TEC LULOG, 'C " ENTER DISPLAY FORMAT tt: _» ) ' ) 

READC LUT, *, ERR=1 )IDN 
I F< ICHKC IDN, 1 ,7))1 ,2, 1 
CONTINUE 

I F< I DN , NE . 7 >GO TO 22 
CLOSE< LUDIR) 

WRITEC LULOG, '< " ENTER NAME OF FILE: 


334 


READC LUT , 'C3A2) ' )C IFILEC I ), 1 = 

835 


GO TO 33 

836 

c~ ci 

DO 3 1=1,6 

837 

3 

IFILEC I )= I DDNMC I , IDN > 

338 

33 

CONTINUE 

y 3 9 


OPENC UN I T=LU6D , F I LE= I F I LE, I OSTA 

84 0 


REWIND LUBD 

841 

4 

DO 5 1=1 , MXIDD 

842 

5 

READC LUBD, *, END=6 )IDD< I > 

843 


CLOSEC LUBD ) 

844 


CLOSEC LUDIR) 

8 45 

6 

RETURN 

8 4 6 

990 

WRITECLULGG, -C " ERROR OPENING » 

847 


END 

TN4;- 

1 COMPILER: HP92334 REV. 21 30 <810716) 


** HO WARNINGS *+ NO ERRORS *+ PROGRAM: 298 


COMMON: 1526 


A-25 


F'AGt 22 I - IN. OF l S'. LVI 8; 50 AM WED,, 20 MAY , i 987 


348 SUBROUTINE FMTOR< LULOG, LUDIR , IDIR ), DISPLAY TLM FORMAT DIRECTORY 

849 C DIMENSION IDIR<6,6), I NA M< 3 ) 

350 C DATA IHAM/6HFMDIR / 

35 1 C UPENC UN I T =LUD I R , F I LE= INAM , I OSTAT = I ST AT , ERR- 99 0 ) 

852 C REWIND LUDIR 

353 C READ<LUDIR )(( IDIR< J,K>, J=t , 6 ),K=1 ,6 ) 

654 C DO 1 0 K= 1 ,6 

855 C WR I TE< LULOG , ' < I 4 , 1 X , 6A2 ) ' )K , < I D I R< J ,K), J= 1 , 6 ) 

856 CIO CONTINUE 

857 C WRITER LULOG, '< " 7 ENTER DISPLAY FILE NAME”)") 

858 C RETURN 

859 990 CONTINUE 

860 WRITEcLULQG, '< " ERROR OPENING FMT DIR”)') 

861 RETURN 

862 END 


FTN4X COMPILER: HP92834 REV. 2130 <810716) 


*+ NO WARNINGS ** NO ERRORS ** PROGRAM: 35 COMMON: (NONE) 


A- 2 6 


FTN . 


LYI 


50 AM WED . 


^ P A G b 

23 

1 

8 1 ~» s 

$Er-1A* 

■ 864 


1 865 


866 


m 867 


1 868 


■ 869 


870 


R 871 


I 872 


873 


| 874 




876 


m 877 


1 878 

1 00 

■ 379 

1 001 

880 


■ 881 


■ 882 

1 002 

8 83 


m 884 


I 885 


9 886 


887 

3 00 

■ o o c* 

3 01 

® 889 


890 

3 05 

■ 891 

3 0 0 0 

Q 892 


893 

2 0 04 

^ 894 


p 895 


® 8 9 6 

C 

897 

C 

| 898 

c 

V 399 


9 0 0 

3 005 

a 9 01 


1 802 

3 02 

9 03 


- 904 

3 03 

■ 9 05 


™ 9 06 

3 1 0 

9 07 

31 2 

9 03 

313 

W 9 09 

3 0 01 

9 1 0 


m 911 


1 912 

32 0 

* 913 

3 0 02 

914 


V 915 

325 

• 9 1 6 


9 1 7 



uPTi 


:0 MAY 


1 937 


KY2, 0 > 

SUBROUTINE PRAMS* MAXP, IER ) 

DIMENSION NEMO< 4 >, I HELP* 2 ) 

COMMON /XYZ/DAT * 1 6384 >, HPT* 16), IDCNT , 1ST* 6 >, I ETC 6 >, MON* 4, 1 6 >, 

*IDN< 16), ITYP* 16), IFREQ< 16>,XMIN* 16>,XMAX< 16>,NPTS 
•+ , SUMX* 16), SUMX2< 16) 

COMMON LUT , LULGG , LU I N , LUW IN , NT AP , INBUF* 1 0),LBUF* 151 0),LUPR 
COMMON/ 1 DAT/ 1 BUF* 256 ), I FLAG , IBTIM* 6 ?, ISTAT* 10), I ANHK* 24 ), IPWR< 4 
*, I TYPE 

COMMON/VDT/ 1 VDT< 7, 200 >, NIBCK 500 ), IVDTN< 6 >, MNE* 4,200 ) 

DATA IHELP/ 'HELP V 
I ER=0 

IF* IDCNT . HE . 0 )THEH ! DISPLAY PARAMS ALREADY CHQSfcN 

DO 100 KL=1, IDCNT 

WRITE* LULOG , 1001 )< MON< K , KL ) , K= 1 ,4) 

CONTINUE 
FORMAT* 1 X , 4A2 > 

NPTS=1 6384/ IDCNT 
WRITE* LULOG, 1 002) 

FORMAT* " THESE ARE THE CURRENT PARAMETERS, DO YOU ",/, 

*" WISH TO ENTER A HEW SET? *Y/N>" > 

READ* LUT, * A 1 > ' >IANS 

IF* IANS , EQ . 1HN )RETURN 

END IF 

I DCNT=0 

IDCNT = I DCNT + 1 

IF* IDCNT, GT.MAXP)GOT0350 

WRITE* LULOG, 3000) 

FORMAT*" ENTER PARAMETER NAME, HELP OR STOP") 

READ* LUT, 2 0 04 >NEMO 
FORMAT* 6A2 ) 

IF* NEMO* 1 > . EG) , 2H9T .AND, NEMO* 2 > . EQ , 2H0P >GO l 035 0 
I F* NEMO* 1 ) . NE . 2HHE . UR . NEMO* 2 ) . HE , 2HLP )G0Tu3 02 

DISPLAY MNEMONICS HERE. , . . 

WRITE* LULOG, 3005 )MNE 
FORMAT*/,* 9* 4A2) )) 

GOTO305 

IDN* IDCNT >=IDGET* NEMO) 

IF* IDN* IDCNT ) >303, 350,31 0 
WRITE* LULOG, 3 002) 

GOTO305 

DO 312 K = 1 ,4 

MON* K , IDCNT )=HEMO*K ) 

WRITE* LULOG, 3001 ) 

FORMAT*" ENTER TYPE < 1 =HEX , 2=ENG , 3-TEMP >_" > 

READ* LUT, +,ERR=320)ITY 
I F* I CHK* I TY , 1 , 3 ) )32 0 , 325 , 32 0 
WRITE* LULOG, 3 002 > 

FORMAT*" INVALID " ) 

G0T031 3 

ITYP* IDCNT )=ITY 

IFREQ* IDCNT )=IVDT* 4, IDH< IDCNT > ) ! GET THE FREQ 

G070301 


I 

I 


A-27 


oj 'jj c*j pc- p.;i ro pj po pj 


OPTS : 


5 0 AM LitD, 


PAGt 24 PRAMS 


L V I 


2 0 MAY , i' 


9 i S' 350 IDCNT=IDCNT-1 

919 DO 355 KL= 1 , I DCNT 

920 WR I TEC LULOG , 3 030 X MON< K , KL ) , K= 1 ,4), 

921 + IDN<KL>, I TYP< KL ) , NPT< KL > 

922 355 CONTINUE 

923 3030 FORMAT < IX, 4A2 , 315 ) 

4 WRITER LULOG, 3 031 > 

5 3031 FORMAT<" ARE THESE PARAMETERS CORRECT? Y/N " > 

6 READ<LUT, '< A1 )' >IANS 

7 IF< IANS.EQ. 1HN)GOT0300 

8 360 NPT S= 1 6384/ 1 OCNT 

9 C CALL XTRAC ! EXTRACT THE DESIRED VARIABLES 

0 C CALL TO XTRACT WAS PLACED IN MAIN PROGRAM, 

1 RETURN 

2 END 


FTH4X COMPILER; HP92834 REV, 21 30 *1810716 ) 

** NO WARNINGS ** HO ERRORS ** PROGRAM: 683 COMMON; 1526 



A-2 8 


•X* 


'X* \0 


SUBROUTINE XTRAC< MAXFRQ > 

RETURN 

END 


933 

4 

5 

FTN4X COMPILER; HP92934 REV. 2 130 <81 071 6 > 

* + NO WARNINGS ** NO ERRORS ** PROGRAM: 6 COMMON: 


< HONE > 


PpGt 26 PIN. 


OP l 9: LVI 


S: 5U AM WtD , , 20 MAY , i 987 


M . < £■% 


937 

C 

938 

C 

y 3 y 

c 

9 4 0 

c 

94 i 

c 

942 

C 

943 

c 

944 

c 

9 4 

c 

946 

c 

947 

c 

948 

c 

949 

c 

95 0 

c 

951 

c 

952 

c 

953 

c 

954 


955 


956 


957 


958 

c 

959 

c 

960 

c 

9 6 1 


962 


963 

22 0 0 

964 

1 

965 

2201 

966 


967 


968 

2202 

969 


97 0 

2 05 

971 


972 


973 

22 03 

9 >■'' 4 


975 

21 0 

976 


977 

22 04 

978 


979 

215 

980 

22 05 

98 1 

0 

982 


983 


984 

2206 

985 


9 8 6 

22 0 

987 


988 


989 

Cl C. 

9 9 0 



SUBROUT I HE GET I M< LUT , LULOG , I STRG , I T I M , I ER > , PROMPT USER FOR TIME 


GETIM PROMPTS THE USERS FOR TIME INPUT. 

FIRST IT ASKS FOR MONTH/DAY/YEAR AND THEN 
IT ASKS FOR HOURS/M I N/SEC. IF NO ERRORS ARE DETECTED 
IT WILL RETURN A VALUE OF ZERO FOR IER . LUT IS THE 
INPUT LOGICAL UNIT, LULOG IS THE LOGICAL UNIT FOR 
DIAGNOSTIC OUTPUT. I STRG IS A STRING < EITHER "BEGINNING" 
OR "ENDING" USED IN PROMPTING INPUT. ON OUTPUT, ITIM WILL 
CONTAIN : 

I T I M< 6 ) = YEAR < TWO DIGITS E.G. 85 > 

I T I M< 5 > = DAY NUMBER < DAY OF YEAR) 

ITIMC4) = MILITARY HOUR NUMBER <0 TO 23) 

I TIM< 3) = MINUTES <0 TO 59) 

I T I M < 2 ) = SECONDS (0 TO 59) 

ITIMC1) = .01 SECONDS (SET TO ZERO IN THIS ROUTINE) 
DIMENSION I T I M< 6 ) 

D I MENS I ON I DA Y< 1 2 ) , I STRG< 4 ) , I MO< 1 2 ) 

DATA I DAY/31 , 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/ 

DATA IMO/O, 31 , 59 , 90 , 1 20 , 1 51 , 1 S 1 ,212,243,273, 304, 334/ 


IER = 1 ! SET ERROR FLAG TO INDICATE ERROR 

WRITE*: LULOG, 2200) I STRG ! PROMPT USER FOR MN/DA/YR 

FORMAT*: " ENTER ",4A2," TIME; MN/DA/YR " ) 

READ< LUT , + ,ERR=1 )MN, IDA, IYR 
FORMAT*: 12, IX, 12, IX, 12) 

I F< MN . GT . 0 . AND . MN . LT . 1 3 )G0T02 05 
WRITE< LULOG, 2202) 

F ORMAT < " WRONG!") 

RETURN 

IF< IDA.GT. 0 . AND , IDA.LE. IDAY< MN ) )G0TQ2 1 0 

IF*: MN . EQ . 2 . AND . AMODC FLOAT*; IYR), 4 . ) . EQ . 0 . .AND . I DAY . EQ , 29 )GGT021 0 
WRITE*: LULOG, 2203) 

FORMAT*:" INCORRECT DAY # "> 

RETURN 

I F*: I YR . GT . 83 . AND , IYR . LT . 99 )GQT02 1 5 
WRITER LULOG, 2204 ) 

FORMAT < " I DON'T THINK THE YEAR IS CORRECT!”) 

RETURN 

WRITE< LULOG, 22 05) 

FORMAT*: " ENTER HRS; MIN; SECS E.G. 14:15:0 0 < = 2:15 PM)") 

READ< LUT , * , ERR=2 1 5 )I HR, MIN, I SEC 

IF*: IHR.GE. 0 . AND . I HR . LT . 24 >GOT0220 
WRITE*: LULOG, 2206) 

FORMAT*: " INVALID ENTRY") 

RETURN 

I F< M IN , GE . 0 , AND . M I N . LT . 6 0 >G0T0225 


WRITE*: LULOG, 22 06) 

RETURN 

I F< I SEC . GE , 0 . AND , I SEC . LT . 6 0 )GOT 023 0 
WRITE*; LULOG, 22 06) 
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i- i N . OP i S ; LYI 8:50 AM UED,., 2 0 MAY , 198/ 

SUBROUTINE S£EK< ISTM, IERR ), SEEK TIME OH INPUT FILE 


SUBROUTINE SEEK LOOKS FOR A REQUESTED TIME IN THE INPUT FILE 


D I MENS I ON I STM< 6 ) , I T I ME< 1 3 ) 

COMMON/ I DAT/ 1 BUF< 256 ), I FLAG, IBTIM< 6 ), ISTAT< 10), I ANHK< 24 ), IPWR< 4 > 
+ , I TYPE 

COMMON LUT, LULOG , LU I N , LUO IN , NTAP , INBUFC 1 0 ), LBUFC 1510), LUPR 
LOGICAL I EOF 
INTEGER CKTM 

I ERR= 1 ! INITIALIZE FLAG TO ERROR 

CALL CNVTM< IBTIM, ITIME) 

URITE< LULOG, 1 000)1 TIME 
CALL CNVTM< I STM, ITIME) 

WR I TE< LULOG , 1 001 ) I TIME 
FORMAT< " SEEKING : " , 1 3A2 ) 

IF<CKTM< IBTIM, ISTM))1 00,300, 300 ! SEE IF WE " RE ALREADY THERE 

READ< LU I N , END= 1 03,ERR=900)ITYPE, IPWR, IBTIM 
I F< ITYPE.EQ. 1 )G0T01 04 
GOTOI 00 

WRITE-; LULOG, 1 0 03) 

FORMAT-;" EOF ON INPUT FILE, CONTINUE? Y/N ” ) 

READ-; LUT, 1 0 04 ) IANS 
FORMAT-; A 1 ) 

IF< IANS.NE. 1 HY )RETURN 
GOTOI 00 

CALL CNVTMC IBTIM, ITIME) 

WR I TE< LULOG , 1 000)ITIME 
FORMAT-;" TIME = *',13A2) 

IF< I FBRK-; KK ) )9 0 0 , 1 01 ,90 0 

IF-; ITIME-; 1 ) , EQ ,2HIN)G0T01 00 

IFCCKTMC IBTIM, ISTM))1 00,300,250 

IF NOT THERE YET, GO BACK TO 100 AND CONTINUE 

IF EXACTLY THERE, GOTO 300 AND RETURN 

IF TIME NOW IS GREATER THAN REQUESTED, ADJUST TIME AND RETURN 
BACKSPACE-; LUIN) 

NTAF-5 

CALL REDATC IEOF, 1 ) 

DO 260 1=1,6 
ISTM< I )= I BT I M< I ) 

IERR=0 

RETURN 

END 


FTN4X COMPILER: HF‘92834 REV, 2130 <810716) 
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1101 
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c 

c 
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c 

c 

c 
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1 

c 

Cl 0 01 


5 

6 

1 002 


1 003 


1 00 


10 0 0 


4 


SUBROUTINE RtDATt IEQF, ITYP ), RtAD NEK i ITYP RtCORD 


REDAT READS MAJOR FRAMES OF HALuE DATA FROM THE INPUT FILE. 

I EOF IS A FLAG PASSED BACK TO MAIN PROGRAM INDICATING END-OF-FILE 
STATUS <= TRUE IF EOF) 


COMMON/ I DAT/ 1 BUF< 256 ), I FLAG.. IBTIM*: 6), ISTATC 1 0), IANHK<24), I P W R < 4 > 
+, I TYPE 

COMMON LUT , LULOG , LU I N , LUWIN , N ,. INBUF< 1 0>,LBUF< 151 0>,LUPR 

N* 5 WHEN PROCESSING MAG TAPE FIRST TIME, OR WHEN SEEKING NEW 
TIME ON MAG TAPE. HOT USED IN DISK FILE MANIPULATION. 

DIMENSION I BUFF< 1510) 

LOGICAL I EOF 
I F< LUIN . EQ , 40 )THEN 

READ< LUIN, EHD=9 00, ERR=6 , IOSTAT=IOS > I TYPE, 

*IPWR, IBTIM, I BUF , IDUM, IANHK, ISTAT 
WRITE-.: LULOG, 1001 > I TYPE, IBTIM 
FORMAT*:” RECORD TYPE, TIME ", 715) 

I F< ITYP . EQ , 0 ) GO TO 5 
I F< I TYPE . NE , ITYP )GQT01 
I EOF= . FALSE . 

RETURN 

WRITER LULOG, 1 002) 

FORMAT*:" END OF FILE ENCOUNTERED , REW I ND , CONT I HUE OR STOP?" 

*" < R/C/S )” ) 

READ< LUT, 1 0 03 )IANS 
FORMAK A! ) 

IF< IANS . EQ . 1 HC )GOT01 
I F< IANS . EQ , 1 HR )THEN 
REWIND-: LUIN) 

GOTOI 
END IF 
GOT0900 

IF< IDS , EG . 496 )GOTQ1 ! ERROR WAS DUE TO SMALLER RECORD TYPE 

WRITE*: LULOG, 1 00 0 )108 

FORMAT*:" ERROR # ",I5," IN REDAT ROUTINE") 

STOP 
ELSE 
N=N + 1 

I F< N . GE . 5 )THEN 
N= 0 

READ< LUIN, END= 7 , ERR= 1 S 00 , I OSTAT= I OS > I BUFF 

END IF 

NN=N+302 

I TYPE= I BUFF< NN+ 1 > 

IF*: ITYP .EQ. 0)GOT04 
IF*: I TYPE . NE . ITYP >G0TQ3 
I EOF= . FALSE . 

CALL MVARY< I BUFF< NN+6 ) , IBTIM< 1 ),6) 

CALL MVARYC IBUFF< NN+t 2 ), I BUF*; 1 ), 256 > 

CALL MV ARY*; IBUFF< NN+293 >, ISTAT< 1 ), 1 0 > 

CALL MVARYf I BUFF*; NN+2 ) , IPWR< 1 ),4) 



H Lib. 


RhUH i 


U r 


: T 

I O 


8 : 5 0 A f‘i Li t D , 


1 1 03 


CALL MVARY< IBUFF< NN+269 >, I ANH 

1 1 04 

c 

LJR I TE< LULOG , 1 001 ) I TYPE, IBTIM 

1 1 05 


RETURN 

1 1 06 


WRJiTE< LULOG , i 0 02 > 

1 1 07 


READ< LUT, 1 0 03 > IANS 

1 1 08 


I F< IhHS.EQ. 1HOG0T02 

1 1 09 


IF< IANS.EQ. 1 HR >THEN 

1110 


REWIND-; LUIN ) 

Mil 


G0TO2 

1112 


END IF 

M 1 3 

9 0 0 

I EOF = . TRUE . 

M 1 4 


RETURN 

1115 

1 8 0 0 

I F< I OS . EQ . 496 )G0T02 

1116 


END IF 

1117 


RETURN 

ills 


END 
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APPENDIX B 


HPLOT 


Program Name : HPLOT 

Function: HPLOT is used to plot HALOE Blackbody data. 

Description: HPLOT is a Fortran V program written on the ACD 

NOS facility. 

Use: HPLOT can be executed using the procedure listed 

below. The plots will be routed to the Calcomp 
plotters automatically. 


. PROC , HPLOTPR , T APENO . 

GET, HPLOT. 

FTN5 , I =HPLOT , L=LF . 

ATTACH , LARCGOS/UN=L I BRARY , NA . 

COMMENT. PROCESSING DONE FOR T APENO DATA. 

GET, TAPE 1=T APENO. 

LDSET , L I B=L ARCGOS , PRESET A=NG I NF . 

LGO. 

. NOTE , < / IF YOU WANT A PRINTED OUTPUT OF DAILY AND WEEKLY 
.NOTE, AVERAGE ROUTE THE TAPE4 TO LINE PRINTER AS FOLLOWS 
. NOTE , ROUTE , TAPE4 , DC=LP/ ) 

REVERT . 
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PROGRAM-UNIT LENGTH 72B - 58 

CM LABELLED COMMON LENGTH 4B ■ 4 

CM STORAGE USED 614008 » 25344 

COMPILE TIME 0.384 SECONDS 
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APPENDIX C 


SPECRES 


Program Name: 


Function : 


Description : 


Use : 


SPECRES . PAS 


SPECRES is designed to acquire data from the HALOE 
GCETS (Gas Correlation Electronic Test Set) during 
the Spectral Response Test. 

SPECRES is written in Turbo Pascal on and for an 
IBM— XT or compatible. The program uses an RS232 
line to communicate with the CD2A Compudrive which 
drives the spectrometer during the spectral 
response test. SPECRES also uses a Lab Master 
card to acquire data from the GCETS which is in 
turn connected to channels of interest in the 
HALOE instrument. 

SPECRES is invoked on the IBM-XT by typing 
SPECRES. The program prompts the user for the 
run-time parameters and file names as needed. 

Data is saved to disk file for plotting and 
tabulating after each spectral run is completed. 


C-l 


Listing of: SPECRES.F'AS 


Page 1 


1 PROGRAM SPECRES 5 

3 C 

4 Haloe Spectral Response data acquisition program. This prograim 

5 communicates with the CD2A Compudrive to determine the wavenumber 

6 setting of the spectr omet er . Each time the wavenumber changes, 

7 Specres will acquire a number of data points for all the selected 

8 channels. The data is recorded on disk to be plotted and analysed 

9 immediately following a spectral response run. 

11 3- 


14 C$U-3- 

15 f RS232 INPUT /OUTPUT ROUTINES > 

16 TYPE REGPACK = RECORD 

17 AX, BX,CX,DX, BP, DI , SI ,DS,ES, FLAGS: INTEGER ; 

18 END; 

20 CON SJ 

21 SIX: BYTE = 6 ; 

22 LF : BYTE = 10 ; 

24 VAR 

25 INSTRING : SIRING! 80 3 ; 

26 RECPACK : REGPACK ; 

27 AH , AL: BYTE ; 

28 0L.DSER , SER : INTEGER ; 

29 Baud , St opBi ts , DataBi ts , PAR: Integer; 

30 Message: Str i. 09 1 801 ; 

31 PORT 1 : INTEGER ; 

32 INCHAR. 0UTCHAR : BYTE ; 

33 INPCHAR: CHAR ABSOLUTE INCHAR ; 

34 OUTF'CHAR: CHAR ABSOLUTE OUTCHAR ; 

35 ONLINE : BOOLEAN ; 

36 printer : boolean ; 

37 type 

38 8tri_ngl9=Stri_ngC 193 ; 

39 Type 

40 Regi sterSet=Record case Integer of 

41 Is (AX,BX,CX,DX,BF',DI ,SE,DS,ES, Flags: Integer); 

42 2: ( AL , AH , BL , BH , CL , CH , DL , DH : Byte); 

43 end; 

44 Par i tyType= (None , Even , Odd ) ; 

46 var 

47 Regs: Register Set; 

48 InError , OutError : Array Cl.. 23 of Byte; 
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51 


□j 

54 

55 

56 

57 


61 

62 

63 

64 

65 


68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
1 00 
101 


SPECTRAL RESPONSE DATA ACQUISITION PROGRAM > 

IYPE 

Filename = Stri_nqC123 ; 

Name = Stri.ngC103 ; 

Names = ArrayCO. .43 of Name ; 

Samples = ArrayC0..43 of real ; 
descript = string C80 3 ; 

LABEL STOP ; 

CONSI 

STARTLOC : INTEGER = $710 ; 

factor : array! 0. . 21 of real = (1.0,10.0,100.0) ; 

rgain: array CO. . 21 of integer = (1,10,100) ; 

MAXCHANnum : INTEGER = 5 ; 


PROMPT : DESCRIPT ; 

MONTH , DAY , HR , M I N , SEC : I NTEGER ; 
bel 1 : char ; 

NCHAN : INTEGER ; 

ITER : INTEGER ; 

NITER : INTEGER ; 

NPTS s INTEGER ; 

COUNTS : SAMPLES ; 
i , j , k : i nteger ; 

IT; INTEGER ; 

CTRLBYTE ; BYTE ; 

STATBYTE : BYTE ; 

Inch ; integer ; 

INF'CH ; ARRAYCO. .153 OF INTEGER ; 

IND : INTEGER ; 

HIGH : BYTE s 
LOW : BYTE ; 
val : real ; 
ref ; real ; 

I CHAN : INTEGER ; 

CHAN : ARRAYCO. .5,0. . 10003 OF REAL ; 
gain ; arrayCO. . 153 of byte ; 
igain : byte ; 

sum , sumx2 , mean ,mi nx , max x , std , nopts ; samples ; 
tsum , tsumx 2 , tmean , tmi nx , tmaxx , tstd , tnopts: samples; 
NAM : NAMES; 

FI : TEXT ; 

FNAME : FILENAME ; 

PLOTS s TEXT ; 

PNAME : FILENAME ; 
lOerror : integer ; 

answer : str i.ngC 1 3 ; 

WAVEL : REAL ; 

WAVELENGTH : real ; C USED FOR WAVENUMBER > 
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102 

103 

104 

105 

106 

107 

108 

109 

1 10 
111 

113 

114 

115 

117 

118 

119 

120 

121 

I nn 
x~x~ 


126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 


DELTA : REAL ; C STEP SIZE 3 

DWELL , STEPS; INTEGER ; 
denom : real ; 

RADICAL : REAL ; 
descrip : descript ; 

RSI NT : ARRAY CO. .1] OF INTEGER ABSOLUJE $0000: $0030 ; 

OLD I NT : ARRAY CO.. 13 OF INTEGER ; 

BUF,PTR,BASE : INTEGER ; 

BUFOUT , BUF I N : INTEGER ; 

Fyoctign Binary(V: Integer): String 19; 

var 

I: Integer; 

B: Array CO.. 3 3 of StringC43; 
begin 

For I : =0 To 1 5 do 

if (V and (1 Shi (15-I)))<>0 then BCI Dyv 43C(I Mod 4)+13:='l' 
eise BCI Dyv 43 C (I Mod 4>+13:='0' ; 

For I : =0 To 3 do BC I 3 C03 : =Chr (4) ; 

Bi nary: =BC03+ ' '+BC13+' ' +BC23+ ' ’ ' +BC33 ; 

end ; 


function KEY IN : INTEGER ; 
begin 

with recpack do 
begin 

ah : = 6 ; 
al := 0; 

ax : = ah shi 8 + al ; 
dx := $f f ; 
intr ($21 .recpack) ; 
al :- ax and $ff ; 

KEY IN al ; 

end; 

end ; 


1 45 FUNCTION CHANNEL < CHANNUM : I NTEGER ) : REAL ; 

146 begin 

147 ctrlbyte := 128 or gai nCCHANNUM3 ; 

148 portCstartloc+43 := ctrlbyte ; 

149 PORT C ST ARTLOC+5 3 := I NPCH C CHANNUM 3 ; 

150 PORT C ST ARTLOC+6 3 := 0 ; 

151 WHILE PORTCSTARTLOC+43 and 128 = 0 DO 

152 BEGIN 
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153 

154 

155 

156 

157 

158 

159 

161 

163 

164 

165 

1 66 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

199 

201 

203 


statbyte := port Estartl oc+43 ; 

END; 

LOW ;= PORTESTARTLOC+53 ; 

HIGH := PORT E ST ARTLOC+6 3 ; 

VAL := high*256.0 + low ; 

if. VAL > 32767.0 then CHANNEL s= VAL -65536.0 
ELSE CHANNEL := VAL ; 


end ; 

PROCEDURE SETGAINS ; 

b|g.in 

•C determine best gain value for each channel > 
INCH ;= 0 ; 


igain s= 0 ; 

VAL : = CHANNEL (15); 

VAL := CHANNEL ( INCH) ; 
countsEinchl s= val ; 
if. ( ab s ( va 1 ) < 200 . 0 ) then 
begin 

igain := 1 ; 

i_f (abs (val ) <20.0) then 

begin 

igain := 2 ; 

end ; 


end ; 

gainEinchl ;= igain ; 
inch := inch +1 ; 
until inch = nchan ; 


END; 

•C read a burst of data > 

ECOCedure readburst ; 

bebin 

•C initialise stats and gains 1 

for ichan : — 0 to NCHAN — 1 do 

begin 

sumEichan3 := 0.0 ; 

sumx2Eichan3 := 0.0 ; 
minx E ichan 3 := 1 . Oe+33 ; 
maxxEichan3 ;= -1. OE+33 ; 
noptsEichan3 ;= 0 ; 
gainEichan3 := 0 ; 

end ; 

SETGAINS ; { DETERMINE BEST GAIN BETTING FOR EACH CHANNEL > 

•C acquire data > 


i nd s = 0 ; 
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204 reetat 

205 INCH := 0 ; 

206 CIM2§?:§.t 

207 NOPTS CINCH! := NOPTSC INCH 3+1 ; 

208 VAL : = CHANNEL (15); 

209 VAL s= CHANNEL (INCH) ; C read ground, REF , THEN CHANNEL > 

210 i IF(REFOO.O) THEN 

211 val := val/ref 

212 ELSE 

213 WRITELN ( ' DIVIDE BY ZERO REF VOLTS'); 

214 > 

215 val := val / (204. 75*f actor Cgai n C i nch 3 3 ) ; 

216 sumCinch! : = sumCinch! + val ; 

217 sumx2Cinch3 s= sumx2Cinch3 + val*val ; 

218 if val < minx Cinch 3 then minx Cinch 3 := val ; 

219 if val > maxxCinch! then maxxCinch! := val ; 

220 inch := inch + 1 ; 

221 until, inch = nchan ; 

222 IND := IND +1; 

223 UNIIL IND = ITER ; C ITER IS NUMBER ITERATIONS PER BURST > 

224 end ; 


228 Procedure MAKEf i 1 e (VAR FL: TEXT; PROMPT: DESCRIPT ; 

229 VAR FNAME: FILENAME; var i oerror : i nteger ) ; 

230 LABEL AGIN ; 

231 begin 

232 -C$I-> C turn off i/a error checking > 

233 AGIN: Wri tel n (PROMPT ); 

234 Read In (FNAME) ; 

235 Assign (fl , FNAME) ; 

236 Reset (fl): C try to rewind the file > 

237 I Oerror : = IOresult ; 

238 if (IOerror <> 0) then C an error will occur if it doesn't exist > 

239 begin 

240 Rewrite (Fl) ; C try to create the file 3- 

241 IOerror := IOresult ; 

242 if (IOerror <> 0 ) then writeln(' error in creating file: ',IQerror:5) 

243 end 

244 else 

245 begin 

246 wri tel n ( ' FILE ALREADY EXISTS, DO YOU WANT TO OVERWRITE IT? (Y/N)') 

247 READLN (ANSWER) ; 

248 IF ( UPC ASE (ANSWER) = 'Y' ) JHEN 

249 BEGIN 

250 CLOSE (FL); 

251 GQIQ AGIN ; 

252 END; 

253 end; 

254 end; 
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257 FUNCTION BCD2DEC ( X : INTEGER ) : INTEGER 5 

258 BEGIN 

259 BCD2DEC := (X DIV 16 ) * 10 + (X MOD 16) 5 

260 END ; 

262 PROCEDURE TIME (VAR MONTH, DAY, HR, MIN, SEC: INTEGER) ; 

263 CONST TIMEBASE = 893 ; 

264 BEG I N 

265 PORT E T I MEBASE 3 : = 2 ; { SELECT SECONDS REGISTER > 

266 SEC : = BCD2DEC ( PORT E T I MEBASE+2 3 ) ; 

267 PORT C TIMEBASE 3 := 3 ; C SELECT MINUTES REGISTER > 

268 MIN := BCD2DEC < PORT E T I MEBASE+2 3 ) ; 

269 PORTE TIMEBASE 3 := 4 5 •£ SELECT HOURS REGISTER > 

270 HR := BCD2DEC (PORTCT I MEBASE+2 3 ) ; 

271 PORTE TIMEBASE 3 := 6 ; •[ SELECT DAY OF MONTH > 

272 DAY :» BCD2DEC < PORT E T I MEBASE+2 3 ) ; 

273 PORT E T I MEBASE 3 := 7 ; •[ SELECT MONTH REGISTER > 

274 MONTH := BCD2DEC (F'ORTETIMEBASE+23 ) ; 

275 END; 

277 ECQ&edure Sel ectchannel s ; 

278 Var i: integer 5 

279 Begirt 

280 WRITELN ( ' ENTER THE NUMBER OF CHANNELS'); 

281 READLN (NCHAN) ; 

282 for i : = O to NCHAN - 1 do 

283 b§?g.i_Q 

284 writeln(' Enter description of channel# ',i:5>; 

285 readl n (NAME 13); 

286 WRITELN ( ' ENTER PLUG POSITION# FOR THIS CHANNEL'); 

287 READLN ( I NPCH r 1 1 > ; 

288 end; 

289 WRITELN ( ' BE SURE THAT THE GROUND (SHORTING) PLUG IS IN POSITION 15'); 

290 I NPCH C 1 5 3 := 15 ; 

291 end; 

293 PROCEDURE ASCIN ; EXTERNAL 'ASCIN.COM' ; 

295 PROCEDURE ASCI NIT ; 

296 BEGIN 

297 BASE := OFS (ASCIN) ; 

298 PTR := BASE + f-2D ; 

299 BUF :=BASE + *2F ; 

300 MEMWECSEG: BASE+f-103 : = PTR ; 

301 MEMWECSEG: BASE+#143 := BUF ; 

302 MEMWECSEG: BA5E+$21 3 := PTR ; 

304 END; 
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307 B.CQ£©dure ASCI I__ENABLE ; 

308 BEGIN 

309 PORT C *3FC 3 := *0B ; 

310 PORTE *2 13 := PORTCS213 AND *EF ; 

311 P0RTC*3F93 := 1 ; 

312 END; 


315 FUNCTION DATA_AVAIL : BOOLEAN ; 

316 BEGIN 

317 DATA_AVAIL := TRUE ; 

318 BUFIN *= MEMW C CSEG : PTR 3 ; 

319 IF BUFIN = BUFOUT THEN DATA_AVAIL := FALSE ; 

321 END; 

323 C Beginning of Main Program 

324 Begin 

326 OLD I NT COD := RSINTC03 ; 

327 OLDINTC 1 3 := RSINTC 1 3 ; 

328 ASCINIT ; 

329 RSINTC03 := OFS(ASCIN); 

330 RSINTC 13 : = CSEG ; 

331 BUFOUT := 0 ; 

332 ASCII JENABLE ; 

333 REPEAJ 

OUTCHAR b= 'KEY IN ; 

IF OUTCHAR <> 0 JHEN 
BEGIN 

REPEAT 

UNTIL <<F'ORTC*3FD3 AND $20) <> 0 ) ;> 
P0RTCS3F83 := OUTCHAR ; 

END ; 

WHILE DAT A_ AVAIL DO 

begin 

INCHAR := MEMCCSE6: BUF+BUF0UT3 ; 

BUFOUT := BUFOUT+ 1; 

IF BUFOUT > 255 IHEN BUFOUT := 0 ; 

CASE INCHAR OF 

32. . 128,10,13: WRITE ( INPCHAR) ; 

5: BEGIN 

REPEAT 

UNTIL ( <P0RTC*3FD3 AND *20) <> 0 ) ;> 
PORTC*3F83 := 6 ; 

END; 

END ; 

END; 

355 UNTIL INCHAR = 26 ; 


334 


336 

337 

338 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 

349 

350 

351 
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357 WRITELN ( ' SPECTRAL RESPONSE DATA ACQUISITION PROGRAM' ); 

358 WRITELN ; 

359 WRITELN (' written by William L. Edmonds ' ); 

360 writeln; 

361 writeln; 

362 writeln; 

363 bell : = chr ($07) ; 

364 PROMPT : = ' ENTER FILE NAME FOR SPECTRAL RESPONSE DATA (ALL PTS) ' ; 

365 MAKEFILE (FL, PROMPT, FNAME, I OERROR) ; 

366 IF (I OERROR <> O ) IHEN GOTO STOP ; 

367 PROMPT := * ENTER FILE NAME FOR PLOT FILE' ; 

368 MAKEF I LE ( PLOTS , PROMPT , PNAME , I OERROR > ; 

369 Sel ectchannel s ; 

370 WRITELN ( ' ENTER TOTAL NUMBER OF DATA POINTS FOR EACH WAVELENGTH'); 

371 READLN (NPTS) ; 

372 ITER := 10 ; 

373 NITER : = NPTS DIV ITER ; 


m 375 
■ 376 

• 377 
378 

ft 379 
ft 380 
381 
M 382 
Q 383 
384 
m 385 

S 386 

• 387 
388 

1 389 
390 
391 
■ 392 

I 393 

394 
m 395 
1 396 

• 397 

398 
m r^.99 
ft 400 
401 
f 402 
1 403 

* 404 

405 
■ 406 

407 


writeln (' Enter description of this run (80 chars) ' ) ; 
readln (descrip) ; 

writeln(' Enter START WAVENUMBER (real number with decimal)'); 
readln (WAVELENGTH) ; 

WRITELN ( ' ENTER DELTA WAVENUMBER (REAL NUMBER )'); 

READLN (DELTA) ; 

WRITELN ( ' ENTER NUMBER OF STEPS (INTEGER)'); 

READLN (STEPS) ; 

WRITELN ( ' ENTER DWELL TIME IN SECONDS (INTEGER)'); 

READLN (DWELL) ; 

writeln (' Type G when ready to start taking data ') ; 

writeln (' OR enter Q to quit') ; 


readl n (answer ) ; 

IF (UPCASE (ANSWER) O'G'l IHEN GOTO STOP; 

WAVEL : = WAVELENGTH ; 
writeln ( + 1 ,descrip) ; 

FOR js= 1 IQ STEPS DO C wavenumber loop > 

BEGIN 

if (UPCASE (answer ) <> 'G' ) then goto stop ; 

WRITELN ( ' WAVELENGTH = ' , WAVEL: 10: 2) ; 

WRITELN (LST, ' WAVELENGTH = ' , WAVEL: 10: 2) ; 

T I ME ( MONTH , DAY , HR , M I N , SEC ) ; 

WRITELN (f 1 , MONTH: 2, '/ ' ,DAY:2, ' /86 ' ,HR:2, ' : ' ,MIN:2, ' : ' ,SEC:2) ; 

wr i tel n (f 1 , 

'parameter minimum maximum mean std dev num pts ' ) ; 

WRITELN (1st, 

MONTH: 2, '/ ' ,DAY:2, ' /86 ' , HR: 2 , ' : ' , MIN: 2 , ' : ' ,SEC:2) ; 

writeln (1st , 

'parameter minimum maximum mean std dev num pts'); 


WRITELN (MONTH: 2, 

'/' , DAY : 2 , ' /86 ' ,HR:2, '; ' ,MIN:2, ': ' ,SEC:2) ; 

wr i tel n ( 

'parameter minimum maximum mean std dev num pts'); 
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408 

409 

410 

411 

412 

413 

414 

415 

416 

417 

418 

419 

420 

421 

422 

423 

424 

425 

426 

427 

428 

429 

430 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 

448 

449 


WRITELN (FL , ' WAVELENGTH = ' , WAVEL: 10: 2) ; 
for ind s= 0 to nchan -1 do 

begin 

tmean E i nd 3 : = 0 . ; 
tsumE i nd 3 : = 0 . ; 
tsumx2Eind3 : = 0 . ; 
tmi nx E i nd 3 : =1 . Oe+33; 
tmaxx Eind3 : =-1 . e+33; 
tnoptsE i nd 3 : = 0 . ; 
tstdE.ind3 : = 0 . p 
end ; 

•C readburst ; read each channel to initialise process > 
for k: = 1 to niter do 
begin 

i readburst ; > 

tor ind := 0 to NCHAN - 1 do 
begin 

meanEind3 := sumE i nd 3 /nopts E i nd 3 ; 

RADICAL := (noptsE i nd 3*sumx2E i nd 3~sumE i nd 3*sumE i nd 3 ) / 

( (noptsE i nd 3-1 ) *noptsE i nd 3 ) ; 

tsumC .i nd 3 : = tsumE i nd 3+sumE i nd 3 ; 
tsumx 2 E i nd 3 : = tsumx2Eind3+sumx2Ei nd 3 ; 

If(minxEind 3<tmi nx C i nd3 ) then tminx C i nd 3 : =mi nx E i nd 3 5 
If (maxx E i nd 3 >tmaxx E i nd 3 ) theg tmaxx E ind 3 : =maxx E i nd 3 ; 
tnoptsEind3 : =tnoptsEind3+noptsEind3 ; 

IF (RAD I CAL >0.0) IHEN 

begin 

STDE IND3 : = SORT (RADICAL) ; 

END 

ELSE 

begin 

STDE IND 3 := 0.0 p 

•C wr i tel n (NAME ind 3:10, mean E i nd 3 : 8 : 4 , stdE i nd 3 : 10:4 

, factor Egai n Eind33:5: 1) ; 

> writeln(Fl ,namEIND3: 10,minXE IND3: 10: 5 , max X E IND3 : 10:5, 

meanC IND3 : 10:5, stdE IND3 : 10: 5 , N0PTSE IND3 : 10:0) ; 

•C wr i tel n <1 st ,namE IND 3 : 10 , mi nX E IND 3 : 10:5, max X E IND 3 : 10:5, 

mean E IND 3 : 10: 5 , std E IND3 : 10: 5,N0PTSE IND3 : 10:0) ; 
y end; C of for loop > 

wr i tel n (f 1 ) ; 

end ; 


451 for ind := 0 to nchan - 1 do 

452 begin 

453 tmeanEind3 := tsumE i nd 3 /tnoptsE i nd 3 5 

454 radical := 0.0 ; 

455 denom := ( ( tnoptsE i nd 3- 1 ) *tnoptsE i nd 3 ) ; 

456 If (denom< >0. O) then 

457 radical : = (tnoptsE i nd 3*tsumx2E .i nd 3 -tsumE i nd 3 *tsumE i nd 3 ) 

458 / denom; 
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459 


if. (radical >0 . 0 ) then 

460 


begin 

461 


tstdCind] := sqrt (radi cal ) ; 

462 


end 

463 


else 

464 


begin 

465 


tstdCind3 : = O, ; 

466 


end ; 

467 


wri tel n (f 1 , namC i nd 3 : 1 0 , tmi nx C i nd 3 : 10:5, tmaxx [ind3: 10:5, 

468 


tmean C i nd 3 : 10: 5, tstdt i nd 3 : 10: 5 , tnoptsC i nd3 : 10:5) ; 

469 


writeln(lst,namCind3: 10, tminx C i nd3 : 10:5, tmaxx E i nd 3 : 10:5 

470 


tmean C i nd 3 : 10: 5, tstdC i nd3: 10:5,tnoptsEind3: 10:5) ; 

471 


writeln(namCind3: 10, tminx Cind3 : 10:5, tmaxx C i nd 3 : 10:5, 

472 


tmean C i nd3 : 10: 5, tstdC i nd3 : 10: 5 , tnoptsC i nd 3 : 10:5) ; 

473 


end; 

474 


WAVEL := WAVELENGTH + j*DEL_TA ; 

475 


WRITELN (bel 1 , 

476 


'ENTER G WHEN READY TO TAKE DATA FOR WAVELENGTH =' 

477 


, WAVEL: 10:2) ; 

478 


RE ADLN (ANSWER) ; 

479 

END; 


480 

stop 

: 

481 


WRITELN (FL) ; 

482 


close (f 1 ) ; 

483 
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APPENDIX D - SPECPLT 


Program Name : 


Function : 


Description : 


Use : 


SPECPLT. PAS 


SPECPLT is designed to plot HALOE spectral 
response data on an HP pen plotter. 

SPECPLT is written in Turbo Pascal for an IBM-XT 
or compatible . 

After each spectral response run is made, it is 
essential to plot the data to determine the 
quality of the data and whether or not an 
additional run under the same conditions is 
necessary. SPECPLT gives the capability of 
plotting the data quickly, allowing several 
parameters to be plotted in different colors on 
the same graph . 


D-l 


Listing of : A: SPECPLT. PAS 


Page 1 


1 ( **************************************************•#•#*•***********•*-*-*•*•#•*•*) 

2 (***********************************************************************) 


3 <* *> 

4 <* TURBO PASCAL PLOT PROGRAM for Spectral *> 

5 <* Response using IEEE 488 BUS DRIVER *> 

6 ( * * ) 

7 <* *> 


8 ( ************************************************************************* ) 

9 (***********************************************************************) 

10 Program Specplt ; 

1 1 type 

12 -filename = string! 123 ; 

13 name = string! 103 ; 

14 names = array CO. . 163 of name ; 

15 cmd = string! 1273; 

16 VALUE = SIRINGC103; 

17 vax = string C 80 3; 

18 fig = integer; 

19 bad = integer; 

20 I NTS = ARRAY CO. . 103 OF INTEGER ; 

21 ANTS = ARRAY CO.. 21 3 OF BYTE ; 

22 param = array C 1 .. 2003 of real ; 

23 STRG = SIRING C 40 3 ; 

24 , CONST ZERO ; SJRINGC33 = ' 0 ' ; 

25 MINEQ s SJRINGC63 = 'MIN = ' ; 

26 MAXEQ ; SIRING C 63 = 'MAX = ' ; 

27 MINIMUM : REAL = 1 . OE+33 ; 

28 MAXIMUM : REAL = -1. OE+33 ; 

29 ET ; BYTE = 3 ; 


31 Label TOP , NEWPLOT , theEnd ; 

70 w-%m- 

X- * 

33 ETX s CHAR ABSOLUTE ET ; 

34 PENPOS ; VAX ; 

35 LAB : STRG ; 

36 ANSWER : CHAR ; 

37 nparam,CHAN : integer ; 

38 params : arrayC1..163 of param ; 

39 PARVAL : string! 103 ; 

40 parnam : ARRAYCO. . 163 OF name ; 

41 F'ARNAME ; NAME ; 

42 waveleng : param ; 

43 WAVEVAL : string Cl 03 ; 

44 parmi n ,parmax : array! 1.. 163 of real ; 

45 wavemi n , wavemax : real ; 

46 title : STRG ; C title of plot can be up to 40 characters > 

47 XL„AB,YLAB, DIR: VALUE ; 

48 date,datime : value ; C 10 character strings for date and time > 

49 XCOORD , YCOORD : REAL' ; 

50 I , J , npt ; INTEGER ; 
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51 

X , Y: VALUE : 


52 

MINX , I'll NY , MAXX , MAXY : REAL ; 


53 

XSF , YSF , XOF , YOF : REAL ; { XS<Y SCALE FACTORS AND OFFSETS > 

54 

XTIC : VALUE ; 


55 

XPOS : REAL 5 


56 

XD IV, YD IV : INTEGER ; 


57 

XDEL , YDEL , ydel ta : REAL ; 


58 

syscon : cmd ; 


59 

f : f 1 g ; 


60 

b : bad ; 


61 

v: vax ; 


62 

RX , RY : REAL ; 


63 

c : cmd ; 


64 

IANS: CHAR ; 


65 

NUMS: INTS ABSOLUTE V ; 


6>6> 

BYTES : ANTS ABSOLUTE V ; 


67 

TEMP : BYTE ; 


68 

spec-File : text ; 


69 

spec-filename : filename ; 


70 

ioerror : integer ; 


71 

PEN : CHAR ; 


73 

Procedure Openfile (var FL: TEXT ; var FNAME: FILENAME; var ioerror 

74 

LABEL AGIN ; 


75 

begi_n 


76 

-C$I-> C turn off i/a error checking > 


77 

AGIN: Writeln(' Enter plot data file name ' ); 

78 

Read In (FNAME) ; 


79 

Assign (f 1 , FNAME) ; 


80 

Reset (f 1 ) ; 


81 

IOerror : = IOresult ; 


82 

i f < I Oer r or < > 0 ) then 


Q7 

beg i n 


84 

writeln<' File : ' ,fnarae, ’ does not 

ex i st 1 ' ) ; 

85 

wr i tel n ( ' DO YOU WANT TO TRY AGAIN? 

(Y/N) ' ) ; 

86 

RE ADLN (ANSWER) ; 


87 

IF (UF‘CASE( ANSWER) = 'Y' ) THEN 


88 

goto agin ; 


89 

end 


90 

el se 


91 

begin 


92 

wr i tel n ( ' OPENING FILE: FNAME); 


93 

end ; 


94 

epd ; 


96 

procedure ReadlnData ( var ioerror : inteqer 

) ; 

97 

VAR PRINT : BOOLEAN ; 


98 

LABEL FINIS ; 


99 

begi n 


1 00 

WRI TELN ( ' DO YOU WANT TO PRINT THE DATA?' 

) ; 

101 

READLN (ANSWER) ; 



i nteger ) 
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102 

103 

104 

105 

106 

107 

108 

109 

1 10 
111 
1 12 

1 13 

114 

115 
1 16 

1 17 

1 18 

119 

120 
121 
X x-j&- 

123 

124 

125 

126 

127 

128 

129 

1 30 

131 

1 32 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 


IF UPCASE< ANSWER) = 'Y' IHEN PRINT := TRUE ELSE PRINT := 

read In ( spec file, title) ; 

writeln(' title : title ) ; 

readln (specf i le, date, datime) ; 

writ.eln(' date and time : ' , date , dat i me) ; 

readln (spec-f i le, npar am) ; 

writeln(' number of parameters = npar am: 5); 

READ ( SPECF I LE , P ARNAM COD) ; 

WAVEMIN : = MINIMUM ; 

WAVEMAX := MAXIMUM ; 

IF PRINT JHEN 
BEGIN 

WRITELN(LST, TITLE ) 5 
WRITELN (LST , DATE , DATIME) ; 

WRITELN<LST, ' NUMBER OF PARAMETERS = NPAR AM); 

WR I TE ( LST , P ARNAM COD) ; 

end; 

for i := 1 to nparam do 
begi.n 

read (specf i le ,parnamCi D ) ; 

IF PRINT IHEN WRITE (LST , PARNAMC I D > ; 

PARMINCID := MINIMUM ; 

PARMAXCID := MAXIMUM ; 


end ; 

IF PRINT 


THEN WRITELN (LST) 


npt 

repeat 


: = O 


until 
FINIS: NPT 
FOR I := 1 

begin 

IF 

IE 

FOR J 

begin 

IE 

IE 

END ; 

END; 
end ; 


npt := npt + 1 ; 

read (specf i 1 e , waveLENGCnpt D ) ; 

IF EOF (SPECF I LE) IHEN GOTO FINIS ; 

IF PRINT IHEN WRITE (LST, WAVELENGCNPTD : 10: 2) ; 

for j:= 1 to nparam do 

begin 

read (specf i 1 e , parAMSC j , npt D ) ; 

IF EOF (SPECF I LE) IHEN GOTO FINIS ; 

IF PRINT IHEN WRITE (LST, PAR AMSCJ,NPTD: 10:5) ; 
end ; 

IE PRINT IHEN WRITELN (LST) ; 
eof (specf i 1 e) ; 


: = NPT- 1 ; 

TO NPT DO 

WAVELENGC I D < 
WAVELENGC I D > 
= 1 IQ NPARAM 

PARAMSC J , I D < 
PARAMSC J , I D > 


WAVEMIN 

WAVEMAX 

DO 


IHEN 

THEN 


WAVEMIN 

WAVEMAX 


= WAVELENGC ID 
= WAVELENGC ID 


PARMINC J D 
PARMA X C J D 


IHEN 

THEN 


PARMINC J D 
PARMAXCJD 


= PARAMSC J 
= PARAMSC J 


t; 


FALSE ; 


, I D ; 

, I D ; 
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154 

procedure IE488 ( VAR c:cmd; 


155 

VAR Vi va;<; 


156 

VAR fsflg; 


157 

VAR b:bad ): external 

' IE488.COM' ; 

159 

PROCEDURE LABEL.IT (VAR LAB: STRG; VAR X,Y, 

DIRECTION: VALUE); 

160 

BEGIN 


161 

V: = ' DI ' + DIRECTION + ' ; ' ; 


162 

I E488 (C , V , F , B) ; 


163 

V := 'PU PA ' + X + Y + ' ; ' ; 


164 

IE48S (C, V,F,B) ; 


165 

V := 'LB ' + LAB + ETX ; 


166 

IE488(C,V,F,B) ; 


167 

END; 



171 

PROCEDURE I NIT IEEE ; 


172 

BEGIN 


174 

f : = 1 ; 


175 

b := 0; 


176 

syscon := ' SYBCON MAD=3, CIC=1 , N0B=1, BA0=&H200 ' ; 


177 

v : = ' ' ; 


178 

IE488 (syscon , v,f ,b) ; 


179 

if f<> 0 then 


180 

writeln ( 'RETURNED FROM IE48B SYSCON PROCEDURE fig = 


181 

F : = 0 ; 


182 

B : = 0 ; 


183 

C := 'TIMEOUT' ; 


184 

V := chr (1) ; 


j ^ i— 

i ao 

IE48S (C,V,F,B> ; 


186 

if f<>0 then 


187 

WRITELN < ' TIMEOUT PROC RETURN WITH FLAG =',F); 


188 

C:= 'OUTPUT 5C$#3' ; 


189 

END; 


191 

PROCEDURE INITPLOT ; 


192 

BEGIN 


194 

V := 'DF IN F’S 4 IP 0,0,9865,7462; ' ; 


195 

IE488 (C , V ,F , B) ; 


196 

V := ' SC -20,100,-10,110 ;'; 


197 

I E488 ( C , V , F , B) ; 


198 

i_f f < >0 then 


199 

WR I TELN < ' INITIALIZED PLOTTER, FLAG = ',F>; 


200 

WRITELN ( ' WHAT PEN NUMBER DO YOU PREFER?'); 


201 

READLN (PEN) ; 


202 

V: = 'SP ' + PEN + ' ; ' ; 


203 

IE488 (C , V , F , B) ; 
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204 V : = 'PA 0 , 0 , PD 1 00 ,0,1 00 , 1 00 ,0,1 00 , 0 ,0 ; ' 5 

205 IE488 (C , V , F , B) ; 

206 V: = ' PU 0,0 ; ' ; 

207 IE488 (C , V , F , B) ; 

209 END; 

211 PROCEDURE AXES; 

212 BEGIN 

213 XDEL := 100.0/XDIV ; 

214 YDEL := 100.0/ YD IV ; 

215 Vs = ' ' ; 

216 FOR I : = 1 IQ XDIV DO 

217 BEGIN 

218 XPOS := I*XDEL ; 

219 STR ( XPOS: 8:4, XTIC) ; 

220 V := 'PA ' + XTIC + ','+ ZERO + ';'+'XT;' 

221 IE488 <C,V,F,B) ; 

222 END; 

223 FOR I s= 1 IQ YDIV DO 

224 BEGIN 

225 XPOS := I * YDEL ; 

226 STR (XPOS: 8 : 4, XTIC) ; 

227 v := 'PA ' + ZERO + ',' + XTIC + ';' + ' YT 

228 I E488 <C,V,F,B) ; 

229 END; 

230 V := 'PU PA 0,0 ; ' ; 

231 IF FOO JHEN WRITELN ( ' ERROR IN AXES = ' ,F> ; 


233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 


END; 

procedure plotline ; 


begin 

I : = 1 ; 

X COORD := (WAVEL.ENGE I 3-XuF) *XSF ; 
YCOORD := (PARAMSCCHAN, I 3-YOF) *YSF 
STR (X COORD: 10: 2,WAVEVAL) ; 

STR (YCOORD: 10: 2,PARVAl_) ; 


penpos := 'F'U ' ; 

V : = penpos + WAVEVAL + ' , + F’ARVAL + ' ; ' 

I E488 (C , V , F , B) ; 

PENPOS := 'PD ' ; 

FOR I := 1 IQ NF’T DO 

begin 

X COORD := (WAVELENGC I 3-XOF) *XSF ; 

YCOORD := (PARAMSCCHAN, I 3-YOF) *YSF ; 

STR (X COORD: 10: 2 , WAVEVAL) ; 

STR ( YCOORD : 1 0 : 2 , PARVAL ) ; 

V : = penpos + WAVEVAL + ' , ' + PARVAL + 
IE488 (C , V , F , B) ; 


END 


w w 
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255 END; 

257 PROCEDURE BETSCALES ; 

258 BEGIN 

260 WRITELN ( ' CURRENT WAVENUMBER MIN AND MAX ARE: ' , WAVEM IN: 10:2, 

261 WAVEMAX: 10:2) ; 

262 WRITELN ( ' CURRENT MIN AND MAX FOR ' , PARNAMCCHAN3 , ' : ' , 

263 PARMINCCHAN3 : 10, ' ' , PARMAX CCHAN3 : 10) ; 

264 wr i tel n ( ' DO YOU WANT TO ADJUST THESE? <Y/N>'); 

265 RE ADLN ( ANSWER ) ; 

266 IF (UPC ASE (ANSWER) = 'Y') THEN 

267 REPEAT 

268 WRITELN ( ' ENTER WAVENUMBER MINIMUM: '); 

269 RE ADLN < WAVEM IN); 

270 WRITELN ( ' ENTER WAVENUMBER MAXIMUM: '); 

27 1 RE ADLN ( WAVEMAX ) ; 

WRITELN ( ' ENTER MIN FOR: ' ,F‘ARNAMCCHAN3 ) ; 

RE ADLN < FARM I N C CHAN 3 ) ; 

WRITELN (' ENTER MAX FOR: ' ,PARNAMCCHAN3 ) ; 

RE ADLN < PARMAX E CHAN 3 ) ; 

WRITELN < ' MIN AND MAX WAVENUMBERS: ' , WAVEMIN: 10: 2, WAVEMAX: 10: 2) ; 

WRITELN (' MIN AND MAX FOR ' , PARN AM C CHAN 3 , PARM INC CHAN 3 : 10, 

', PARMAX CCHAN3: 10) ; 

WRITELN ( ' ARE THESE VALUES OK? (Y/N)'); 

RE ADLN (ANSWER) ; 

UNTIL UPCASE (ANSWER) = 'Y' ; 

XDEL := WAVEMAX- WAVEM IN ; 

YDEL. := PARMAX C CHAN 3 —PARM INC CHAN 3 ; ; 

XSF := 100. O/XDEL ; 

YSF := 100.0 /YDEL ; 
vnrr i.iaucmtki ■ 

aui a — r»n r i — i i * ii 4 

YOF := PARM INC CHAN 3 ; 
ydelta := ydel ; 

END ; 


93 PROCEDURE YLABEL (pmin ,pmax : real ; pnam: name) ; 

94 BEGIN 

296 V : = ' F’U PA 0 0 ; ' ; 

297 IE488 (C , V , F , B) ; 

298 YLAB := '0 ' ; 

299 STR (Pmin: 10, LAB) ; 

300 LAB := MINED + LAB ; 

301 DIR := '01 ' ; 

302 LABELIT (LAB, XLAB, YLAB, DIR) ; 

304 YLAB := '40 ' ; 

305 LAB : = Pnam ; 


273 

274 

275 

276 

277 

278 

279 

280 
281 
282 

283 

284 

285 

286 
r>cj-7 

288 

289 

290 
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306 DIR 5 = '0 1 ' ; 

307 LABEL IT (LAB, XLAB,YLAB, DIR) ; 

309 YLAB ; = ' 70 ' ; 

3 10 STR ( F’max : 1 0 , L AB ) ; 

311 LAB 5 = MAXEQ + LAB ; 

312 LABELIT(LAB,XLAB, YLAB, DIR) ; 

314 END; 

316 C SPECPLT MAIN PROGRAM 

318 BEGIN 

319 INITIEEE ; t INITIALIZE IEEE BUS FOR PLOTTING > 

321 TOP: OPENFILE (specfi le,specfi lename, ioerror) ; 

323 i_£ ioerror < >0 then goto theEnd ; 

324 Readi ndata ( i oerror ) ; 

325 if i oerror < >0 then goto theEnd ; 

327 NEWPLQT: 

329 XDIV := 10 ; 

330 YD IV := 10 ; 

FOR I : = 1 TO NPARAM DO 

WR I TELN< 'CHANNEL# ',1:5, P ARNAM E I 3 : 12) ; 

WRITELN ( ' ENTER CHANNEL # TO PLOT AGAINST WAVELENGTH'); 
READLN (CHAN) ; 

SETSCALES ; 

338 TNITPLOT ; 

339 AXES ; 

340 XLAB := ZERO ; 

341 YLAB := '100 ' ; 

342 DIR := ' 10 ' ; 

343 LABELIT (TITLE, XLAB, YLAB, DIR) ; 

344 XLAB := ' 50 ' ; 

345 LAB := DATE + ' ' + DATIME ; 

347 LABELIT (LAB, XLAB, YLAB, DIR) ; 

349 PLOTLINE; 


XLAB := ' 0 ' ; 

YLAB := '-5 ' ; 

STR (WAVEMIN: 8: 2, LAB) ; 

LAB := MINED + LAB ; 

LABELIT (LAB, XLAB, YLAB, DIR) ; 






336 
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358 XLAB := '40 ' ; 

359 YLAB : ~ '-5 ' ; 

360 LAB := PARNAMCOH ; 

361 LABELIKLAB, XLAB, YLAB, DIR) ; 

363 XLAB : = ' 70 ' ; 

364 STR ( WAVEMAX : 8: 2 , LAB) ; 

365 LAB := MAXEQ + LAB ; 

366 LABELIT (LAB, XLAB, YLAB, DIR) ; 

368 XLAB := '-5 ' ; 

369 YLABEL (parmi n Cchan3 , parraax CchanU , par name chan 3 ) ; 

371 WRITELN ( ' DO YOU WANT TO PLOT ANOTHER CHAN ON SAME PLOT? (Y/N)'); 

372 RE ADLN ( ANSWER ) ; 

373 IF UPCASE (ANSWER) = 'Y' THEN 

374 BEGIN 

375 WRITELN < ' WHAT PEN NUMBER DO YOU PREFER?'); 

376 RE ADLN (PEN); 

377 V: = 'SP ' + PEN + ' ; ' ; 

378 IE488 <C, V,F,B) ; 

379 XLAB := '-10 ' ; 

380 FOR I : = 1 TO NPARAM DO 

381 WR I TELN( 'CHANNEL# ' , 1 : 5 , PARNAME I 3 : 12) ; 

382 WRITELN ( ' ENTER CHANNEL # TO PLOT AGAINST WAVELENGTH'); 

383 READLN (CHAN) ; 

384 WRITELN (' DO YOU WANT TO USE THE SAME SCALE-FACTOR (Y/N) '); 

385 READLN ( ANSWER ) ; 

386 IF UPCASE (ANSWER) = 'N' IHEN 

387 SETSCALES 

388 else 

-?oo YOF ■ — n n * 

391 YLABEL (0. 0,ydelta, parnamCchan] ) ; 

392 PLOTLINE ; 

394 END; 


398 v : = ' SP 0 ; ' ; 

399 IE488 (C , V , F , B) ; 

400 WRITELN (' DO YOU WANT TO CONTINUE? (Y/N)'); 

401 READLN ( ANSWER ) ; 

402 IF (UPCASE (ANSWER) ='N') IHEN 

403 GOIQ THEEND 

404 ELSE 

405 BEGIN 

406 WRITELN ( ' SAME FILE? (Y/N) ') ; 

407 RE ADLN ( ANSWER ) ; 
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408 

409 

410 

41 1 

412 

413 

414 


IF ( UPC ASE ( ANSWER ) = ' Y ' > TOEN GQIQ NEWPLOT ; 
CLOSE (SPECFILE) j 
GOTO TOP; 

IND; 

THEEND: 

CLOSE (SPECFILE) ? 

END. 
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APPENDIX E - MONITOR 


Program Name: 


Function: 


Description: 


Use : 


MONITOR. PAS 


MONITOR is designed to acquire HALOE major frames 
of data and to limit check the data before 
displaying it on a color monitor in color coded 
form. MONITOR will also archive data to disk for 
off-line processing. 

MONITOR is a Turbo Pascal program written on an 
IBM— XT . 

MONITOR will be used to limit check, display and 
archive HALOE major frames of data during refurb 
testing and UARS I & T (Upper Atmosphere Research 
Satellite Integration and Testing) . It will be 
part of an overall quick-look system for HALOE. 
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1 


1 


4 

5 

6 
7 

e 

9 
10 
1 1 

13 

14 

15 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 


34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 


PROGRAM MONITOR ; 


Monitor is a HALOE program designed to process HALOE 
major frames of data sent to the IBM-XT (or compatible) 
by the IETS HP-1000 over the HPIB (IEEE-488 interface bus). 
Monitor will convert the raw counts to engineering units 
and perform limit checking and color coding of the data 
before display on the color monitor. Monitor will also 
archive data to disc for transfer later to an off-line 
system for further processing and evaluation. 

THIS PROGRAM WILL SET UP AN INTERRUPT VECTOR TO ITSELF, 

AND LOCK ITSELF IN MEMORY TO BE CALLED BY FORTH LATER 
USING AN INTERRUPT 48 (HEX) > 

type 

ivdt = record C variable definition data > 

leng : byte ; 
loc : integer ; 
bitpos, equatnum : byte ; 

SCRF'OS s INTEGER ; i SCREEN POSITION > 

IDNAM : SIRING C83 ; 
end ; 

icoef = record C coefficients for conversion equations > 

slope, offset : real ; 
end ; 

regs = record 

AX,BX,CX,DX, BP , SI ,DI , DS , ES , FLAGS : INTEGER ; 

Ib)D; 

var 

RE 6 SET : REGS s 
CSEGM , OFFS : INTEGER ; 

ID1 , ID2 s INTEGER ; 

ANSWER s CHAR ; 

VDTfileNAM : SIRING! 153 ; 
vdt : ivdt ; 

vtble : array! 1 .. 2003 of ivdt ; 

VDTFILE : FILE OF IVDT ; 
c oefFILEnam : string! 153 ; 
coef : icoef ; 

coefTBLE : ARRAY! 1.. 503 OF ICOEF 5 
COEFfile : file of icoef ; 

WORDNUM : INTEGER ; 

BYTEDISP : INTEGER ; 

BITDISP : BYTE ; 


50 const datseg JARRAYI0..13 OF integer - (0,0) 5 
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51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
1 00 
101 


STSE6 : INTEGER = 0 ; 

EXSEG : INTEGER = 0 ; 

STPT 5 INTEGER = 0 ; 
oldstseg : integer = 0 ; 
oldstpt : integer = O ; 
base : integer = $200 ; 

HEXDIG : ARRAYCO. . 153 OF CHAR = ' 0123456789ABCDEF ' ; 

var 

SCRNMODE : ARRAYCO. . 153 OF BYTE ; [DISPLAY PARAMETERS FOR GRAPHICS} 
dataseg : ARRAYCO.. 13 OF integer absolute datseg ; 

STACKSEG : INTEGER ABSOLUTE STSEG ; 

STACKPT : INTEGER ABSOLUTE STPT ; 

ESSEG : INTEGER ABSOLUTE EXSEG ; 

ZILCH : integer ; 

INTVEC : ARRAY CO ’.13 OF INTEGER ABSOLUTE $0000: $0120; 
basearray : array CO. .153 of. byte absolute $0000: $0200 ; 
year, day: stririgC53 - 
hours, minutes, seconds : j§tringC33 ; 

DELTA, ST ART, STOP: REAL ; 
sore : stri_ngC803 ; 

type 

ABC = STRING C 80 3 ; 
cmd = strlngC 1273 ; 
vax = str i_ngC2553 ; 
fig = integer; 
bad = integer; 

I NTS = ARRAYCO. .3023 OF INTEGER ; 

ANTS = ARRAYCO. .6043 OF BYTE ; 

INTEGBUFF = ARRAYCO. . 40003 OF INTEGER ; 

BYTEBUFF = ARRAYCO. . 80003 OF BYTE ; 

HEXVAL = STBINGC43 ; 

var 

COMM : INTEGER ; C HOLDS COMMAND VALUE FROM ODD OR EVEN COMMAND WORD 
INDEX : INTEGER; C COMM IS USED TO CALCULATE INDEX OF COMMAND IN TBLE 
port21 : byte ; C 8259 interrupt mask register > 
txt : text ; 
txtfile : stri_ngC103 ; 
att : integer ; 

I ,J,ind: INTEGER ; 

COUNT : INTEGER ; 
syscon: cmd; 
f : f 1 g ; 
b : bad ; 

needmoredata : boolean ; 

STATUS : INTS ; 

STAT : VAX ABSOLUTE STATUS ; 
numsaddr : INTS ; 

NUMSAD : VAX ABSOLUTE NUMSADDR ; 
c:cmd; 

IANS: CHAR ; 
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103 
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105 

106 

107 
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109 
1 10 
111 
112 
1 13 


116 

117 

118 

119 

120 

121 

I DO 

123 

124 

125 

126 

127 

128 

129 


132 

133 

134 

135 

136 

137 

138 

139 


143 

144 

145 

146 

147 

148 

149 

150 

151 

152 


3 


NUMS: I NTS ; 

BYTES : ANTS ABSOLUTE NUMS : 

V : VAX ABSOLUTE NUMS 5 
TEMP : BYTE ; 

FRAME : INTEGBUFF ABSOLUTE #B800: $0000; 

BFRAME : BYTEBUFF ABSOLUTE #B800: $0000; 

TIMER : BYTE ABSOLUTE #0040: #006C 5 

mask, mask2, numl ,num2, shift: integer ; C used by bits function > 
L I NENUM , CH ARNUM : INTEGER ; 

SCRNINT : ARRAY CO.. 13 OF INTEGER ABSOLUTE #0000: #0014 ; 

STORINT : ARRAY CO.. ID OF INTEGER ; 

STATF'R : BYTE ABSOLUTE #0050: #0000 ; 


PROCEDURE SETINTVEC(SEGM, OFFS: INTEGER) ; 

•C set up interrupt vector number #48 (hex) to point to 
the main subroutine > 
var ah,al : byte ; 

BEGIN 

WITH REGSET DO 
BEGIN 

DS := SEGM ; 

DX := OFFS ; 
ah := #25 5 

AX : = ( ah shl_ 8 ) or #48 ; 

I NTR ( #2 1 , REGSET ) ; 

END; 

END; 


EUNQIION HEX (VAL: INTEGER) : HEXVAL ; 

■C convert val into a hex string > 

begin 

HEX := HEXDIGC VAL SHR 12D + 

HEXDIGC (VAL SHR 8 ) AND 15D + 
HEXDIGC (VAL SHR 4) AND 153 + 
HEXDIGC VAL AND 153 ; 

END; 


FUNCTION BITS(NUMS: ints; IND: INTEGER; BITPOS, LENGTH: BYTE) : INTEGER ; 
•C extract length bits from bitpos of numsCindD 3 

begin 

BITPOS := 16 - BITPOS ; 

NUM1 := NUMSCINDD; 

NUM2 := NUMSCIND+1D ; 

SHIFT := BITPOS - LENGTH ; 

IF SHIFT < O THEN 

begin 

MASK := (#FFFF SHR (16 - BITPOS)) ; 
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154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 


171 

172 
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174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 
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196 
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199 

200 
201 
202 
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MASK2 s = #hFFF ibHR (16+SHIFT) ; 

BITS : = ( (NUM1 AND MASK ) SHL -SHIFT) OR 

< (NUM2) SHR < 16 + SHIFT)) AND MASK2 j 

IND 

else 

IF SHIFT = 0 JHEN 

begin 

MASK := $FFFF SHR ( 16 - LENGTH ) ; 

BITS := MASK AND NUM1 ? 

END 

else 

BEGIN 

MASK := *FFFF SHR (16 - LENGTH) ; 

BITS 3= <NUM1 SHR SHIFT) AND MASK ; 

END; 

END; 


BCQcedure SCRDUMP(var i,js integer) ; 

TYPE CHARBUFF = ARRAY CO. . 8000 1 OF CHAR ; 
VAR CFRAMEs CHARBUFF ABSOLUTE $BB00s *0000; 
PRFRAME s ARRAY CO. .40003 OF CHAR ; 

K , 1 3 INTEGER ; 
begi n 

IF 7 I +3 = 0) THEN 

begin 

FOR K s= 0 IQ 3999 DO 

begin 

PRFRAMECKD s = CFRAME C K*2 3 ; 

END; 

END; 

for 1 s = 0 to 4 do 
begi_n 

Li ( J < 7 9 ) then 
begin 

WRITE <LST,PRFR AMEC 1*80 + j3) ; 

end 

else 

begin 

wr i tel n ( 1 st , PRFRAME C I *80+ j 3 ) ; 

end; 

js= j+i; 
end ; 

If ( j >79) then 

begin 

j:=0; 

i 3 = i + 1 ; 

If ( i >48) then 
begin 
i : = 0 ; 
statpr s=0; 
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end ; 
end ; 
end ; 


FUNCTION STACK : INTEGER ; EXTERNAL 'STACK.COM' 5 
•C STACK RETURNS VALUE OF STACK POINTER > 

FUNGI ION ESEGM : INTEGER ; EXIERNAL 'ESEG.COM' 5 
•C RETURNS VALUE OF ES ..EXTRA SEGMENT REGISTER > 


procedure 


IE488 ( VAR 
VAR 
VAR 
VAR 


c : cmd ; 
v: vax ; 
f : f lg; 
b : bad ) ; 


external 'IE488.COM'; 


PROCEDURE S5080 (var i :byte); EXIERNAL 'C0N0.C0M'; 

C S5080 PUTS THE C0N0GRAPHICS SYSTEM IN THE DESIRED MODE: 

At program start, it puts the screen in 50 row, 80 column mode. 
At termination, it returns the screen to 25 X 80 . > 

PROCEDURE PUTOUTCVAR S0RC: ABC; VAR FRAME: INTEGER; ATTR: INTEGER) ; 
EXIERNAL ' PUT0UT . COM ' ; 

■i F’UTOUT places a string and its color attributes 
in the screen memory area > 

FUNQIION PRSTAT: INTEGER; EXIERNAL 'PRSTAT.COM'; 

•C PRSTAT responds to the shift-PrtSC keys by setting a flag. 

The program will then dump the screen to the printer 
50 rows by 80 columns > 

FUNCII0N XYP0S( ROW, COL: INTEGER ): INTEGER ; 

BEGIN 

X YF'OS := ROW * 80 + COL; 

END; 


pr ocedur e NEWSCREEN ; 

•C set up conographics screen mode with 80 columns and 50 rows > 
BEGIN 

SCRNM0DEC03 := $71 ; 

SCRNMODECU := $50; 

SCRNMODEC23 := $5 A; 

SCRNM0DEC33 s= $0F; 

SCRNM0DEC43 := $1B; 

SCRNMQDEL53 := 65 
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255 

SCRNM0DE C 63 : = 

= $19; [ 

256 

SCRNMODEC 7 3 := 

= $1 A; j 

257 

SCRNMODEC 83 := 

- *T » 1 

!» ■' l 

258 

SCRNMODEC 93 := 

= 7; | 

259 

BCRNM0DE C 1 0 3 

= $20 ; 

260 

SCRNMODEC 113 

= $20 ; 

261 

SCRNMODEC 123 

= 0; 

n / n 

j'_.0 

SCRNMODEC 133 

= 0; 

263 

SCRNMODEC 143 

= 0; | 

264 

SCRNMODEC 153 

= 0; 

265 

S5080 ( SCRNMODE C 0 3 ) ; | 

i 

267 

END; 


269 

PROCEDURE OLDSCREEf* 

•i ; 

270 

•C restore old screen mode > 1 

271 

VAR LOC : INTEGER 


272 

BEGIN 


273 

FOR LOC := 0 

IQ 3999 DO 

274 

FRAME! LOC 3 := 

= $F00 ; 

276 

SCRNMODEC43 

= $1F ; 

277 

SCRNMODEC 7 3 

■ $1C ; 

278 

SCRNMODEC83 

= 2; 

279 

SCRNMODEC 103 

: = 6; 

280 

SCRNMODEC 113 

- = 7 • 

281 

S5080 < SCRNMODE C 0 3 ) ; 

282 

END; 


284 

PROCEDURE DISPLAYACRO ; 

285 

•C display background for limit check screen > 

286 

VAR I: INTEGER; 


287 

BEGIN 


288 

txtfile : = 'HALQE. 

SCR ' ; 

289 

assign (txt, txtfile) ; 

290 

reset ( tx t ) ; 


291 

att := 15 ; 


nOO 

-C-TjL 

i : = 0 ; 


293 

while not eof < tx t ) 

do 

294 

begin 


295 

read In (txt ,sorc) ; 


296 

sore := sore + 

5 

297 

putout (sore , frame! i 3 , att ) ; 

298 

i : = i + 80 ; 


299 

end ; 


300 

close (txt); 


302 

END; 



t 
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306 •£ PROCEDURES & FUNCTIONS > 

308 PROCEDURE OUTPUT (OAR SORC: ABC; VAR FRAME: INTEGER; ATTR: INTEGER); 

309 VAR BLANKS : ABC ; 

310 BEGIN 

311 C BLANKS := ' ' ; 10 BLANKS > 

312 C PUTOUT (BLANKS, FRAME, WHITE) ; > 

313 PUTOUT (SORC, FRAME, ATTR) ; 

314 END; 

316 function bcd2dec (x : i nteger ): i nteger ; 

317 £ convert bed value x into decimal value > 

318 begin 

319 bcd2dec : = (x div 16 )*10 + (x mod 16) ; 

320 end ; 


323 FUNCTION TIME: REAL ; 

324 CONST TIMEBASE = 893 ; 

325 VAR TSEC,HUNDSEC, SEX, MENS: INTEGER ; 

326 BEGIN 

327 PORT E T I MEBASE 3 := O ; £ SELECT THOUSANDTHS OF SECONDS REGISTER > 

328 TSEC := BCD2DEC ( PORT C T I MEBASE+2 3 ) ; 

329 PORTE TIMEBASE 3 := 1 ; £ SELECT HUNDREDTHS AND TENTHS REGISTER > 

330 HUNDSEC : = BCD2DEC ( PORT C T I MEBASE+2 3 ) ; 

331 PORT E T I MEBASE 3 := 2 ; 

332 SEX := BCD2DEC ( PORT E T I MEBASE+2 3 ) ; 

333 PORTE TIMEBASE 3 := 3 ; 

334 MENS := BCD2DEC (PORTE T I MEBASE+2 3 ) ; 

336 TIME := TSEC/ 1000. + HUNDSEC/ 100. + SEX + MENS*60.0; 

337 END; 

339 PROCEDURE DISPLAY (ITEM, NDEC , XPOS , YPOS , COLR: INTEGER > ; 


340 

BEGIN 


341 

STR ( I TEM : NDEC , SORC ) 

■ 

5 

342 

PUTOUT ( SORC , FRAME E X YPOS ( XPOS , YPOS ) 3 , COLR ) ; 

344 

END; 


346 

PROCEDURE DISPLAYDATA ; 


347 

VAR VALU , K : INTEGER ; 


348 

xvalu : real ; 


349 

VDT 1 , VDT2 : IVDT ; 


350 

KDV , XV , XDV , BBI , BBV : 

REAL ; 

352 

CONST COLON : CHAR = ' : ' 

jl 


353 LABEL THEexit ; 

354 BEGIN 


356 str ( numsE 103 : 5 , year ) ; 
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357 

358 

359 

360 

361 

362 

363 

364 

365 

366 

367 

368 

369 

370 

371 

372 

373 

374 

375 

376 
"^ 7*7 

378 

379 

380 

381 

382 

383 

384 

385 

386 

387 

388 

389 

390 

391 


str (numsC93 : 5, day) ; 

str (numsC83 : 3, hours) ; 

str (numsC73 : 2 , mi nutes) ; 

str <numsC63:2, seconds) ; 

sore := year + day + hours + COLON 

+ minutes + COLON + seconds ; 
put out (sore , f rameCxypos (0, 57) 3 , yel 1 ow) ; 

FOR I : = 1 JO 10 DO 
BEGIN 

VDT != VTBLEC I 3 ; 

IF VDT. SCRPOS > 6 IHEN 

BEGIN 

K := VDT.LOC -1 ; 

VALU := BITS <NUMS,K, VDT. BITPOS, VDT. LENG) ; 

J := VDT. EQUATNUM ; 

IF J > 128 IHEN J := J -256 ; 

IF J > 0 IHEN 

BEGIN 

If ( J < 51) and (j <> 2) then 
begin 

COEF := COEFTBLEC J 3 ; 

xvalu != valu* (COEF. SLOPE) + COEF. OFFSET ; 

str <x val us 6: 3 , sore ) j 

end 

else 

IF (1=94) OR (1=95) IHEN 
BEGIN C EVEN OR ODD COMMAND 3 


SORC := HEX (VALU) +' 

PUTOUT ( SORC , FRAME C VDT . SCRPOS 3 , GREEN ) ; 

COMM t — VALU SHR 12 ; C GET COMMAND NUMBER > 
VALU != VALU AND 4095 ; 

CASE COMM OF 

1,3,5,7,9,11,13,15; INDEX ;= COMM dw 2 + 110 ; 
0,2,4,6,8,10,12,14; INDEX ;= COMM div 2 + 100 ; 
END; 


393 

394 

395 

396 

397 

398 

399 

400 

401 

402 

403 

404 

405 

406 

407 


VDT ;= VTBLEC INDEX 3 ; C SELECT TABLE ENTRY FOR 

THIS COMMAND > 

sore ;= hex (valu); 

END 

else 

STR (VALU; 6, SORC ) ; 

END 

ELSE 

begin 

SPECIAL PROCESSING. . EQUIVALENT OF ISPCL IN HP SOFTWARE} 

J ;= ABS(J) -25 ; 

IF <J<0) OR < J >6 ) IHEN GQIQ THEex i t ; 

CASE J OF 

1 “7 3 4 . 

BEGIN 
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408 


ID2 s= 2*J j 

409 


ID1 := ID2 -1 5 

410 


VDT1 := VTBLEEID13 ; 

411 


VDT2 := VTBLEE ID23 ; 

412 


K := VDT1.L0C -1 ; 

413 


XV := BITS (NUMS , K , VDT 1 . BITPOS , VDT 1 . LENB) ; 

414 


COEF s= COEFTBLE C VDT 1 . EQUATNUM 3 ; 

415 


XV ;= XV*COEF. SLOPE + COEF. OFFSET ; 

416 


K := VDT2.L0C -1 ; 

417 


XDV s = BITS(NUMS,K,VDT2. BITPOS, VDT2. LENG) ; 

418 


COEF := COEFTBLE CVDT2. EQUATNUM 3 ; 

419 


XDV ;= XDV*COEF. SLOPE + COEF. OFFSET ; 

420 


KDV ;= 58.0; 

421 


IE IHEN 

422 


BEGIN 

423 


XDV := XDV + 4.639 ; 

424 


KDV := 29.0 ; 

425 


END; 

426 


XVALU s= XDV/KDV*1 . E 6 ; 

427 


END; 

428 


5,6: 

429 


BEGIN 

430 


VDT 1 := VTBLEC21 3 ; C BBI > 

431 


VDT2 s — VTBLEC483 ; { BBV > 

432 


K: = VDT1.L0C -1 ; 

433 


BBI :=BITS (NUMS, K,VDT1. BITPOS, VDT1. LENG) ; 

434 


COEF := COEFTBLE C VDT 1. EQUATNUM 3; 

435 


BBI := BB I *COEF . SLOPE + COEF. OFFSET ; 

436 


K := VDT2.L0C -1 ; 

437 


BBV := BITS (NUMS,K,VDT2.BITP0S,VDT2. LENG) 

438 


COEF := CQEFTBLEE83 ; 

439 


bbv 3= bbv*coef . slope + coef.offset ; 

440 


XVALU s= BBV - BBI*0. 5 ; 

441 


IE J=<£> IbEN XVALU := XVALU/BBI ; 

442 


END ; 

443 


END; f OF CASE > 

444 


STR ( XVALU : 1 0 : 4 , SORC ) ; 

445 


END; 

446 


PUTOUT ( SORC , FRAME C VDT . SCRPOS 3 , GREEN ) ; 

447 

TheE;;it: 

END; 

448 

END; 


449 

end; 



453 grocedure main ; 

454 begin 

455 port21 : = port[*213 ; 

456 port C#21D := port21 or 1 ; 

457 numsaddrC03 : = seg(numsE03) ; 

458 numsaddrC13 : = ofs(numsE03) ; 
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459 C CHECK FOR SCREEN DUMP > 

460 [ IF STATF'R = 1 THEN 

461 REPEAT 

462 SCRDUMP ( L I NENUM , CH ARNUM ) ; 

463 UNTIL STATPR = 0 ;> 

464 STR ( T I MER : 4 , SORC ) ; 

465 SORC s= 'TIMER = ' + SORC ; 

466 PUTOUT < SORC , FRAME C 1 220 3 , WH I TE > ; 


469 

470 

471 

472 

473 

474 

475 

476 

477 

478 

479 

480 

481 

482 

483 

484 

485 

486 

487 

488 

489 


if needmoredata then 
begio 

C:= 'ENTER CWD, 0,3013' ; -Z set up -for DMA transfer of 604 bytes > 
IE488 (C , numsad ,F ,B) 5 -C input 302 words of data input v array > 

needmoredata : = FALSE ; 

•C START : = TIME ;> 

end 
efse 
begin 

•C COUNT := COUNT + 1 ; > 

C: = 'REQUEST' ; 

STATUS! 03 := 0 ; 

IE488 (C,STAT,F,B) ; 

if << STATUS CO 3 AND $200) = 0) then 
begin 

•C STOP := TIME ; > 

•C DELTA := STOP - START ;> 

•C WRITELN < ' ITERATIONS = ', C0UNT:5,' TIME = ' , DELTA: 10: 5) ; > 

•C COUNT := 0 !> 

FOR I := 1 JO 302 DO 
BEGIN 


490 

J := 2*1 ; 

491 

TEMP := BYTES! J 3 ; 

492 

BYTES! J 3 := BYTESCJ + 13 ; 

493 

BYTES CJ+ 13 := TEMP ; 


494 

end; 


495 

displaydata ; 

needmoredata := true 

496 

end; 


497 

end; 


498 

port C$21 3 := port 21 ; C restore 

interrupt mask for 8259 > 

499 

end; 



502 

procedure INTieee; 




503 

begin 




504 

inline< $FB/ 

r 

!■ 

ST I 

ENABLE INTERRUPTS > 

505 

$50/ 

f 

L 

PUSH 

AX > 

506 

$53/ 

r 

L 

PUSH 

bx y 

507 

$51/ 

r 

4 . 

PUSH 

ex y 

508 

$52/ 

/ 

4. 

PUSH 

dx y 

509 

$56/ 

r 

4 . 

PUSH 

si y 
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510 $57/ £ PUSH DI > 

511 $le/ £ PUSH DS > 

512 $06/ £ PUSH ES > 

513 $55 £ PUSH BP > 

514 ) ; 

515 INLINE <$2E/$C5/$3E/DATSEB) ; £ SET DS REG TO DATA SEG > 

516 LQllne < 

517 $le/ £ push ds > 

518 $07 ) ; I pop es > £ turbo ds & es are same 3- 

519 LQLLQE <$2e/$89/$26/ol dstpt ) ; £ save old stack pointer > 

520 INLINE ($2E/$8B/$26/STPT) ; £ SET STACK POINTER > 

521 i_nl_i_ne($2e/$8c/$16/oldstseg) : £ save old stack seg > 

522 INLINE ($2E/$8E/$16/STSEG) ; £ SET STACK SEGMENT REG > 

523 MAIN 5 £ CALL MAIN PROCEDURE > 

524 inline ($2e/$8b/$26/oldstpt) ; £ restorr old stack pointer J 

525 inline ($2e/$8e/$16/oldstseg) ; £ restore old stack segment > 


527 

i nl i ne ( 

$5d/ 

r 

L 

POP 

BP 

> 

528 


$07/ 

jr 

V 

POP 

ES 

> 

529 


$lf / 

£ 

POP 

DS 


530 


$5f / 

r 

L 

POP 

DI 

> 

531 


$5e/ 

£ 

POP 

SI 

> 

532 


$5a/ 

r 

L 

POP 

DX 

y 

533 


$59/ 

£ 

POP 

CX 

y 

534 


$5b/ 

,r 

POP 

BX 

y 

535 


$58/ 

r 

POP 

AX 

y 

537 


$cf 

r 

u 

I RET 

y 

538 


); £ 

RETURN TO 

4TH 

> 



540 end; 


545 £ PAS4TH MAIN PROGRAM 


548 BEGIN 

549 COUNT := 0 ; 

550 newscreen ; 

551 displayacro ; 

552 needmoredata := true ; 

553 f := 1; 

554 b := 0; 

555 ST0RINTC03 := SCRNINTC03 ; [SAVE PRINT SCREEN VECTOR > 

556 ST0RINTC13 := SCRNINTC 1 3 ; 

557 SCRNINTC 03 := OFS(PRSTAT) ; 

558 SCRNINTC 13 := CSEG ; 

559 STATPR := 0 ; 

560 LINENUM := 0 ; 
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561 

563 

565 

566 

567 

568 

569 

571 

572 

573 

574 

576 

577 

578 

579 

580 

581 

582 

583 

584 

586 

587 

588 

589 

590 

591 

592 

593 

594 

595 

596 

597 

598 

599 

600 
601 
602 

603 

604 

606 

607 

608 

609 

610 
61 1 


CHARNUM := 0 : 

•C get coe-f f i ci ent -file name > 

writeln(' enter coe-f f i ci ent file name (usually coef.dat)'); 
readl n (coef Fi 1 eNam) ; 

•Ccoef FILEnam := 'coef.dat' ;> 
assign (coef FILE , COEFf i 1 eNAM ) ; 

RESET (C0EFFILE) ; 

•C read in coefficients 3- 

FOR I : = 1 IQ 50 DO 

READ ( COEFF I LE , COEFTBLE [13); 

CLOSE (COEFFILE) ; 

•C get variable definition table file name 3- 

WRITELN ( ' ENTER VARIABLE DEFINITION FILE NAME (USUALLY VARDEF.DAT)') 
READLN ( VDTFILENAM) ; 

ASSIGN ( VDTFILE , VDTFILENAM) ; 

RESET (VDTFILE) ; 

{ read in variable definition table > 

FOR I : = 1 IQ 200 DO 

READ ( VDTFILE, VTBLECI 3) ; •£ READ IN THE VARIABLE DEFINITION TABLE 3- 

CLOSE (VDTFILE) ; 

•£ set up ieee-488 bus. my address = 3 (MAD=3) 

computer in charge= 1, number of ieee-488 cards = 1, 
base address for ieee card = 200 hex 3- 
syscon := 'SYSCON MAD=3 , CIC=1 , N0B=1 , BA0=&H200 ' ; 
v : = ' ' ; 

■C send i ni t i al i z at i on command contained in string syscon 3 
IE488 (syscon , v ,f , b ) ; 

-f » ='?• 

t . — z. , 

b : =0 5 

C: = ' PASCTL 0' ; 

•C writeln ( 'PASSING CONTROL TO HP ' ) ; > 

•C need to send control to HP-1000 > 

IE488 (c , v , f , b ) ; 

F:= 0; 

Bs = 0 ; 

C := 'TIMEOUT' ; 

V : = chr ( 1 ) ; 

•C set up for infinite time out value > 

IE488 (C , V , F , B) ; 

ESSEG := ESEGM ; 
datasegCOl := DSEG ; 

DATASEGC 1 1 := DSEG ; 

WRITELN ( ' ESEG & DESG =', ESSEG: 6 , DATASEGC 03 : 6) ; 

STACKSEG := SSEG ; 

STACKPT := STACK ; 
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613 csegm s = cseg ; 

614 offs := o-f s ( I NT i eee ) + 7 ; -C THE •+• 7 SKIPS OVER TURBO PROCEDURE CODE > 

615 SETINTVEC (CSEGM, OFFS) ; 

616 writeln(' PAS4TH CS,OFS : ' , i nt vec E03 : 6 , intvec C 1 3 : 6) ; 

617 l writeln(' Datseg = ' , datseg C03 : 6 , datsegC 1 3 : 6) ; > 

618 -I port C f-2083 := 1 ; > 

620 •[ interrupt type 27 hex allows a program to terminate while locking 

621 itself in memory. This main program is never re-entered, but interrupt 

622 type 48 hex will cause the main procedure to be called which in turn 

623 utilizes the rest of this program code 3- 

624 intr ($27, zi lch) ; 

625 END. 
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